Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

New Function needed to check offset cell for a date 2

Status
Not open for further replies.

ljsmith91

Programmer
May 28, 2003
305
US
I need a VBA NEW function that I can insert it into a given cell and it would do the following:

Stay on the same row but check +20 columns over for the cell.

If the cell is empty or "NA" then check next cell to the left or same row, column +19.

If the cell contains the date, then I need to grab the header for that column or Row 1, same column and insert it into the cell that conatins the new(this) Function.

I need to check from column +20 columns down to +10 columns over and if I find ONLY Empty or "NA" then insert "No Date Found".

I have no idea how to start this as I am just a rookie. Can someone help me in the right direction for such a routine?

Any help would be great.

Thanks
 


"I need to check from column +20 columns down to +10 columns over "

What does columns down mean?

Skip,

[glasses] [red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
Poultry in motion to pullet for a paltry amount! [tongue]
 
Skip...sorry for my poor explaining skills.

IF the Funstion is placed in row 5, column 5 then it needs to first check row 5, column 25(+20 over), if no date, check row 5, column 24, if no date then row 5, column 23...all the way down to row 5 column 15(+10) when it can stop. The first date found, that's the header I need to grab.

Any guidance would be great as I dont know how to get started. Thanks.

 


Code:
Function NewFunction()
    Dim iCol As Integer, lRow As Long
'Stay on the same row but check +20 columns over for the cell.
'
'   If the cell is empty or "NA" then check next cell to the left or same row, column +19.
'
'   If the cell contains the date, then I need to grab the header for that column or Row 1, same column and insert it into the cell that conatins the new(this) Function.
'
'   I need to check from column +20 columns down to +10 columns over and if I find ONLY Empty or "NA" then insert "No Date Found".
    With ActiveCell
        For iCol = 20 To 1 Step -1
            For lRow = 0 To 15
                If IsDate(.Offset(lRow, iCol)) Then
                    NewFunction = Cells(1, iCol + .Column).Value
                    Exit Function
                End If
            Next
        Next
    End With
    NewFunction = "No Date Found"
End Function

Skip,

[glasses] [red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
Poultry in motion to pullet for a paltry amount! [tongue]
 
Skip,

That's great stuff... and all so fast. That helps so much...thanks so much.

I have 2 questions. AT this point in your code:
For lRow = 0 To 15
If IsDate(.Offset(lRow, iCol)) Then
NewFunction = Cells(1, iCol + .Column).Value
Exit Function
End If

It looks like you are incrementing the row. Is that true ? Told you I am a rookie. I ONLY need to stay on the same row and check offset col +20 to offset col +10. I just want to make sure I am not incrementing the row too. The rookie in me says I am.

Also, you check for date with "IsDate". If the cell has a date but is not formatted as a DATE cell, will it still grab the value?

Thanks again for the incredible help.

 


Yea, the COLUMN needs to change before the row
Code:
    With ActiveCell[B]
        For lRow = 0 To 15
            For iCol = 20 To 1 Step -1[/B]
                If IsDate(.Offset(lRow, iCol)) Then
                    NewFunction = Cells(1, iCol + .Column).Value
                    Exit Function
                End If
            Next
        Next
    End With
just switch the two For...Next.

Skip,

[glasses] [red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
Poultry in motion to pullet for a paltry amount! [tongue]
 
Thanks Skip...

It works great to a point.

When I add the NewFunction into a Cell, it works great searching the offsets and populating the Cell with the correct date.

However, if the Function is already there and it has determined a date value and then a new Date is placed within the offset area then the Function doesn't appear to recalculate based on a new date value being added within the range.

I thought that was the beauty of functions. I cam entering it into the cell as =NewFunction(). What am I doing wrong?

Thanks.
 


Then ActiveCell won't work, cuz there's only ONE activecell on a sheet.

You'll have to select the cell directly to the RIGHT of the activecell as an argument...
Code:
Function NewFunction(rng As Range)
    Dim iCol As Integer, lRow As Long
'Stay on the same row but check +20 columns over for the cell.
'
'   If the cell is empty or "NA" then check next cell to the left or same row, column +19.
'
'   If the cell contains the date, then I need to grab the header for that column or Row 1, same column and insert it into the cell that conatins the new(this) Function.
'
'   I need to check from column +20 columns down to +10 columns over and if I find ONLY Empty or "NA" then insert "No Date Found".
    With rng.Offset(0, -1)
        For lRow = 0 To 15
            For iCol = 20 To 1 Step -1
                If IsDate(.Offset(lRow, iCol)) Then
                    NewFunction = Cells(1, iCol + .Column).Value
                    Exit Function
                End If
            Next
        Next
    End With
    NewFunction = "No Date Found"
End Function
[/codee]

Skip,
[sub]
[glasses] [b][red]Be Advised![/red] [/b] A chicken, who would drag a wagon across the road for 2 cents, is…
[b] Poultry in motion to pullet for a paltry amount![/b] [tongue][/sub]
 
Skip,

Huh ? You lost me...are you saying that when creating a new Function, I will not be able to place the value of the Function into the Cell that contains the Function? I will have to use the cell next to it ? I guess that I don't understand.

I tried your new code and it now places a #VALUE error into the cell that has the Funstion and #VALUE into the cell to it's right.

The cell to the right had data in it...do I need to provide a blank cell to the right for this? I am fully confused. Sorry. Can you help me understand?
 


in C5 I enter the function, referencing D5...
[tt]
=NewFunction(D5)
[/tt]
Works on my sheet.

Skip,

[glasses] [red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount! [tongue]
 
Ok,

I understand the premise...and I updated the Function to pass the next cell to the right and the code works again but with the same issue. If I remove a date from the range the function checks, or add a new date, the function still does not recognize that a change took place.

Your sample works when you modify something in the range the function is checking ? Mine acts like nothing changed.

What am I doing wrong?
 


Do you have Calculation options set to automatic or manual?

Tools/Options - Calculation tab

Mine calculates on any sheet change.

Skip,

[glasses] [red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount! [tongue]
 
It is set to Automatic...

This is frustrating to have something that works but which will not function automatically.

There must be something I am doing different. I haven't a clue.

Thanks for all of your help Skip.
 
Have a look at Volatile:
Function NewFunction(rng As Range)
[!] Application.Volatile[/!]
Dim iCol As Integer, lRow As Long
...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
PHV,

That did the trick. Don't know enough to know why but it works great. Both Skip and you responded with such helpful info. You both know your stuff.

Thanks so much.

-ljs
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top