Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping through a spreadsheet
Hi;
I tried variuos codes, with no luck. Don't mind the extra variables. it's left over from previous code which I have been trying. Here is what I am trying to do: When the excel opens, it should automatically check all the dates in Column B. The difference between today's date and the date in Column B will determine the color of the Cell. Dim dDate As Date Dim LRange As String Dim dCalendar As Date Dim dDiff As Integer Dim rCell As Range, rng As Range Dim vT5 As Variant Dim rSource As Range Dim rDest As Range Private Sub Workbook_Open() With Sheets("Non-Production") Set rSource = .Range("B2:B" & .Range("B" & _ Rows.Count).End(xlUp).Row) End With For Each rCell In rSource With rCell dCalender = Cells(ActiveCell.Row, 2) dDiff = DateDiff("d", dCalender, Date) If dDiff = "" Then Next rCell If dDiff = 30 Then Cells(ActiveCell.Row, 2).Interior.ColorIndex = 10 ElseIf (dDiff < 30) And (dDiff = 15) Then Cells(ActiveCell.Row, 2).Interior.ColorIndex = 6 ElseIf dDiff <= 14 Then Cells(ActiveCell.Row, 2).Interior.ColorIndex = 3 Else Cells(ActiveCell.Row, 2).Interior.ColorIndex = 3 End If End With Next rCell End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping through a spreadsheet
Delete: If dDiff = "" Then Next rCell
Replace all instances of Cells(ActiveCell.Row, 2) with rCell. Hth, Merjet |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping through a spreadsheet
Try:
Private Sub Workbook_Open() With Sheets("Non-Production") Set rSource = .Range("B2:B" & .Range("B" & _ Rows.Count).End(xlUp).Row) End With For Each rCell In rSource With rCell On Error Resume Next If .Value < "" Then dCalender = .Value dDiff = DateDiff("d", dCalender, Date) If dDiff < "" Then If dDiff = 30 Then .Interior.ColorIndex = 10 ElseIf (dDiff < 30) And (dDiff = 15) Then .Interior.ColorIndex = 6 ElseIf dDiff <= 14 Then .Interior.ColorIndex = 3 Else .Interior.ColorIndex = 12 End If End If End If On Error GoTo 0 End With Next 'rCell End Sub Regards Trevor "anon1m0us" wrote in message oups.com... Hi; I tried variuos codes, with no luck. Don't mind the extra variables. it's left over from previous code which I have been trying. Here is what I am trying to do: When the excel opens, it should automatically check all the dates in Column B. The difference between today's date and the date in Column B will determine the color of the Cell. Dim dDate As Date Dim LRange As String Dim dCalendar As Date Dim dDiff As Integer Dim rCell As Range, rng As Range Dim vT5 As Variant Dim rSource As Range Dim rDest As Range Private Sub Workbook_Open() With Sheets("Non-Production") Set rSource = .Range("B2:B" & .Range("B" & _ Rows.Count).End(xlUp).Row) End With For Each rCell In rSource With rCell dCalender = Cells(ActiveCell.Row, 2) dDiff = DateDiff("d", dCalender, Date) If dDiff = "" Then Next rCell If dDiff = 30 Then Cells(ActiveCell.Row, 2).Interior.ColorIndex = 10 ElseIf (dDiff < 30) And (dDiff = 15) Then Cells(ActiveCell.Row, 2).Interior.ColorIndex = 6 ElseIf dDiff <= 14 Then Cells(ActiveCell.Row, 2).Interior.ColorIndex = 3 Else Cells(ActiveCell.Row, 2).Interior.ColorIndex = 3 End If End With Next rCell End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping through a spreadsheet
Thanks...It worked great!!!!!
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Looping through a spreadsheet
You're welcome. Thanks for the feedback.
"anon1m0us" wrote in message oups.com... Thanks...It worked great!!!!! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Looping | Excel Programming | |||
Looping | Excel Programming | |||
Looping | Excel Programming | |||
Checkboxes to spreadsheet using a looping macro | Excel Programming | |||
Need Looping Help | Excel Programming |