Excel VBA help

nofam · 06-21-2009, 10:03 PM

Hi guys,

Wondering if someone can help me with my VBA code.

Basically what I have is a marketing promotional schedule on Sheet1 with dates running from B3:GS3, and the promotion name running in A4:A30. When "Event Held" is entered in any cell that is an intersection of those ranges, I want the code to add reminder notices at weekly intervals starting from 8 weeks prior to the date, and every week thereafter, color-coded as per the code.

The below code works, but not for every instance of "Event Held" in the above range. How can I 'tweak' the code to get it working?

Quote:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range

On Error Resume Next
Set r = Sheet2.UsedRange.Find(What:="Event held", LookAt:=xlWhole)

If Not r Is Nothing Then
With r.Offset(0, -56)
.Value = "8 Weeks"
.Interior.Color = RGB(255, 153, 204)
End With
With r.Offset(0, -49)
.Value = "7 Weeks"
.Interior.Color = RGB(255, 204, 153)
End With
With r.Offset(0, -42)
.Value = "6 Weeks"
.Interior.Color = RGB(255, 204, 153)
End With
With r.Offset(0, -35)
.Value = "5 Weeks"
.Interior.Color = RGB(255, 204, 153)
End With
With r.Offset(0, -28)
.Value = "4 Weeks"
.Interior.Color = RGB(255, 204, 153)
End With
With r.Offset(0, -21)
.Value = "3 Weeks"
.Interior.Color = RGB(255, 204, 153)
End With
With r.Offset(0, -14)
.Value = "2 Weeks"
.Interior.Color = RGB(255, 204, 153)
End With
With r.Offset(0, -7)
.Value = "1 Week"
.Interior.Color = RGB(255, 204, 153)
End With

End If
End Sub

David M58 · 06-22-2009, 05:57 PM

Here's another approach.

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim idx As Long
    If Not (Intersect(Target, Range("B4:GS30")) Is Nothing) Then
        If LCase(Target.Cells(1, 1).Value) = "event held" Then
            For idx = -56 To -7 Step 7
                If (Target.Column + idx) > 1 Then
                    With Cells(Target.Row, Target.Column + idx)
                        .Value = idx / -7 & " Week" & IIf(Not (idx / -7) = 1, "s", "")
                        If (idx / -7) = 8 Then
                            .Interior.Color = RGB(255, 153, 204)
                        Else
                            .Interior.Color = RGB(255, 204, 153)
                        End If
                    End With
                End If
            Next idx
        End If
    End If
End Sub