Check for the Date

[sindhuja]

hi all,

i need for the date based on the below criteria

predate=today'sDate-1 (based ont he network days)

for a specific value of column 1 there should be a predate. If not then the value in column 1 to be highlighted.

for ex, todays date is 10/16/2008 and the predate should be 10/15/2008.
For a value in column a (F1) there should be a date of 10/15. If not, then change the color of the cell.

For each value in the column A there will be set of values for which we should check for the criteria and there will be blank rows inbetween.

have attached the sample sheet...
Thanks in advance for the help...

-Sindhuja

[nepotist]

Hi,
I have uploaded a sample code for what i have understood. step in to the code to see its function. Are the number of rows fixed for each set like F1,F2... ??
I have written the code for just f1. Hope that help
Please find the attachment

[sindhuja]

Hi Nepotist,

No, the number of rows is not fixed. It varies daily.
But the number of blank rows will be constant.

I need to check for all the values in the column A and color if criteria matches.

-Sindhuja

[nepotist]

but still will yo be having all the F1,F2 ..... groups in column A and Column B???

[sindhuja]

yes, Column A with F!, F2 , F3 values and so on...
and column B with date values...

[nepotist]

I am getting of work now will try to play around and come up with something.. Hope some one helps you bythen.

[CreganTur]

Technically this belongs in the Excel Help forum. I put up a post (http://www.vbaexpress.com/forum/showthread.php?p=163034#post163034) over there, so hopefully one of the Excel gurus will be able to solve your issue.

[nepotist]

sub color()
Dim i As Integer
Dim j As Variant
Dim a As String
Dim rFoundCell As Variant
a = "F2"
Dim cel As Range
Set rFoundCell = Range("A1")
Set rFoundCell = Columns(1).Find(What:="f2", After:=rFoundCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
With rFoundCell
i = .Row
End With
j = "B1:B" & (i - 4)
criteria = Format((Now() - 1), "mm/dd/yyyy")
result = WorksheetFunction.CountIf(Sheet1.Range(j), criteria)
If result > 0 Then
Sheet1.Range("A2").Interior.ColorIndex = 12
Else
Sheet1.Range("a2").Interior.ColorIndex = 0
End If
End Sub
First this code is incomplete.

My idea:
determine the range that needs to looked for the predate.I assumed that the number of rows that will be blank between each set is constant(4 in this case) so I kind a started of with trying to pull the F2 cells row number and column number and trying to use it in a loop. the current code works. the work that needs to be done is rfoundcell should also be automated....and then looping it.

I know it is not fair on my part to give an incomplete code.... But i need to go...thought you could use this idea and make it work... I will work on it once i get back..

I hope you get done by then. If you have already figures out how to do it could you please post to code so that I could have another opinion

[sindhuja]

Thanks Nepotist...

Let me also try this and get back if i am able to do so...


-Sindhuja

[nepotist]

Any luck???

[sindhuja]

Hi,

I tried the below coding !!
The challenge with the script is that it its not considering the last set of values.
Any idea why is it so...


Dim Predate
Dim MTRow, IntRow
Dim ClrCell
Dim myArray()
ClrCell = True
Predate = Date()-1
MTRow = 0
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open _
("C:\Documents and Settings\dat.xls")
IntRow = 1
intCol = 2
arrtmpRow = 1
Do
If objExcel.Cells(IntRow,2).Value = Predate Then
ClrCell = False
End If
If objExcel.Cells(IntRow,2).Value = "" And objExcel.Cells(IntRow,1).Value = "" Then
MTRow = MTRow+1
'If MTRow = 1 Then ClrCell = True
End If
If MTRow = 1 And objExcel.Cells(IntRow,1).Value <> "" Then
MTRow = 0
arrtmpRow = arrtmprow & "," & IntRow
If ClrCell = True Then
arrClrCellVal = split(arrtmprow,",")
ClrCellVal = arrClrCellVal(ubound(arrClrCellVal)-1)
MsgBox "Color cell =" & clrCellVal
End If
ClrCell = True
End If
IntRow = IntRow + 1
If MTRow > 5 then Exit Do
Loop
WScript.Echo arrTmpRow
objExcel.Quit


-Sindhuja

[nepotist]

First Looking at your code I would say I am naive... It kind a looks greek and latin to me :D
In order to test this code , I guess I could use you previous sheet that you provided. Only change that I made is i deleted the first row and was testing it.
I lost at this part

If MTRow = 1 And objExcel.Cells(IntRow,1).Value <> "" Then
MTRow = 0
arrtmpRow = arrtmprow & "," & IntRow
If ClrCell = True Then
arrClrCellVal = split(arrtmprow,",")
ClrCellVal = arrClrCellVal(UBound(arrClrCellVal)-1)
MsgBox "Color cell =" & clrCellVal
End If
ClrCell = True
End If
Though this condition is met

If MTRow = 1 And objExcel.Cells(IntRow,1).Value <> ""
it skips to first end if .. Am I right or am I doing something wrong???

I am sure I cant help you but could you please explain the idea behind it.