Previous Topic Next Topic

Excel 2003 question. on conditional formatting using VBA

Closed
throesch Posts 2 Registration date Tuesday May 26, 2015 Status Member Last seen June 6, 2015 - May 27, 2015 at 07:17 AM
throesch Posts 2 Registration date Tuesday May 26, 2015 Status Member Last seen June 6, 2015 - Jun 6, 2015 at 01:47 AM
Hello,

i have been trying to figure out how to make my code stop bugging out on me. any and all help will be greatly appreciated. 
Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer

Dim Cell As Range
Dim CellB As Range
Dim lnCurrent As Long, lnRange As Long
Dim q As String
Dim qq As String
Dim dq As String
Dim y As String
Dim dy As String
Dim m As String
Dim dm As String

'Find out what Quarter we are in
q = Format(Date, "q")
'Find out what Year we are in
y = Format(Date, "yy")
'Find out what Month we are in
m = Format(Date, "mm")


If Intersect(Target, Range("A:B")) Is Nothing Then Exit Sub

    For Each Cell In Range("A:A")
        Select Case Cell.Value
            Case vbNullString

            Case "Q" ' quarterly
                 r = Target.Row
                
                'Find out what quarter and year the inputed date is in
                dq = Format(Range("B" & r), "q")
                dy = Format(Range("B" & r), "yy")
                              
                If (q = dq) And (y = dy) Then
                    Range("B" & r).Interior.ColorIndex = 4 'Green
                ElseIf q = 1 Then
                        If (y - 1) = dy And dq = 4 Then
                            Range("B" & r).Interior.ColorIndex = 8 'Teal
                        Else
                            Range("B" & r).Interior.ColorIndex = 3 'red
                        End If
                ElseIf q > 1 Then
                        If (q - 1) >= 1 And (q - 1) = dq And y = dy Then
                            Range("B" & r).Interior.ColorIndex = 8 'Teal
                        Else
                            Range("B" & r).Interior.ColorIndex = 3 'red
                        End If
                Else
                    Range("B" & r).Interior.ColorIndex = 3 'Red
                End If
            
            Case "M" 'monthly
              '  for later use
            Case "Y" ' yearly
              '  for later use
            Case "S" ' Semiannually 
              '  for later use
            Case Else
                                   
                Range("B" & r).Interior.ColorIndex = xlNone
                Cell.Interior.ColorIndex = xlNone
                
        End Select
    Next
    
        For Each CellB In Range("B:B")
        Select Case CellB.Value
        Case Null
            CellB.Interior.ColorIndex = xlNone
        Case vbNullString
            CellB.Interior.ColorIndex = xlNone
        End Select
        Next
 
'If Target.Count > 1 Then Exit Sub

End Sub


OK so here is what im trying to do and some what getting the response i expect. Column A has single letters (Q,M,S,Y). i have it made so i will color code the cells in Column B. based off the Case from Column A. every thing works great if i fill in Column B first but if i put a Q in column A i get a Type mismatch on this line of code any i just dont know why. 
If (q - 1) >= 1 And (q - 1) = dq And y = dy Then
I think im going about this the wrong way but cant figure out any other way. im not to worried about M,S,Y should be much easier after i figure out Q.

Any and all help will be greatly appreciated.

Thank you in advance,
Related:

1 response

Answer 1 / 1
throesch Posts 2 Registration date Tuesday May 26, 2015 Status Member Last seen June 6, 2015
Jun 6, 2015 at 01:47 AM
Ok so i got this code to work, but I'm having issues with making it work in multiple columns. Column A:name1 B:Date1 C:name2 D:Date2
Columns A and C will have either (M,Q) and will eventually have more for different functions like bimonthly,Semiannual,Yearly. 

Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer

Dim Cell As Range
Dim q, qq, dq
Dim y, dy, m
Dim dm, dd
Dim ldtm, td, fdlm
'Find out what Quarter we are in
q = Format(Date, "q")
'Find out what Year we are in
y = Format(Date, "yy")
'Find out what Month we are in
m = Format(Date, "mm")

'If Intersect(Target, Range("A:B")) Is Nothing Then Exit Sub
    r = Target.Row
    For Each Cell In Range("A2:A45")
        Select Case Cell.Value
            Case vbNullString
                If Range("A" & r) = Empty Then
                    Range("B" & r).Interior.ColorIndex = 1
                    Exit Sub
                Else
                    Cell.Interior.ColorIndex = 1
                End If
            Case "Q" ' quarterly
                If Range("B" & r).Value = Empty Then
                    Range("B" & r).Interior.ColorIndex = xlNone
                    Exit Sub
                Else
                'Find out what quarter and year the inputed date is in
                    dq = Format(Range("B" & r), "q")
                    dy = Format(Range("B" & r), "yy")
                    If (q = dq) And (y = dy) Then
                        Range("B" & r).Interior.ColorIndex = 4 'Green
                        Exit Sub
                    ElseIf q = 1 Then
                        If (y - 1) = dy And dq = 4 Then
                            Range("B" & r).Interior.ColorIndex = 8 'Teal
                            Exit Sub
                        Else
                            Range("B" & r).Interior.ColorIndex = 3 'red
                            Exit Sub
                        End If
                    ElseIf q > 1 Then
                        If ((q - 1) >= 1) And (q - 1) = dq And (y = dy) Then
                            Range("B" & r).Interior.ColorIndex = 8 'Teal
                            Exit Sub
                        Else
                            Range("B" & r).Interior.ColorIndex = 3 'red
                            Exit Sub
                        End If
                    Else
                        Range("B" & r).Interior.ColorIndex = 3 'Red
                        Exit Sub
                    End If
                End If
            Case "M" 'monthly
                If Range("B" & r).Value = Empty Then
                    Range("B" & r).Interior.ColorIndex = xlNone
                    Exit Sub
                Else
                    dm = Format(Range("B" & r), "mm")
                    dy = Format(Range("B" & r), "yy")
                    td = Format(Range("B" & r), "mm/dd/yy") 'formate todays date
                    ldtm = Format(DateSerial(Year(Date), Month(Date) + 1, 0), "mm/dd/yy") 'get last day of next month
                    fdlm = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm/dd/yy") 'get first day of last month
                    If (y = dy) And (m = dm) Then
                            Range("B" & r).Interior.ColorIndex = 4 'Green
                            Exit Sub
                        ElseIf (td <= ldtm) And (td >= fdlm) Then
                            Range("B" & r).Interior.ColorIndex = 8 'Teal
                            Exit Sub
                        ElseIf (dm = 12) And (dy = (y - 1)) And (m = 1) Then
                            Range("B" & r).Interior.ColorIndex = 8 'Teal
                            Exit Sub
                    Else
                        Range("B" & r).Interior.ColorIndex = 3 'Red
                        Exit Sub
                    End If
                End If
            Case "Y" ' yearly
              '  for later use
            Case "S" ' Semiannually
              '  for later use
            Case Else
                Cell.Interior.ColorIndex = 1
        End Select
    Next
End Sub


this code works just fine for columns A and B but when i try to copy the code to make it for the next set of columns it doesnt do anything except in column B. if i remove the Exit Sub from the Cases it will only show green and no other color.

The purpose for this code is to make it possible to review binders/Programs and have multiple personnel review them and update when they did so that we know when the last one was done and if its coming up for review or missed.
0

Similar discussions

Highlight cell if another cell contains specific text
Abbi -
vcoolio -

1 response
Keyboard troubles
jimbobjoe -
car -

38 responses
How to use conditional format based on text?
Leanne99 -
Mooseman -

26 responses
Date formatting in dd/mm/yyyy
nisha -
appu -

11 responses