Search code examples
vbaexcelcalendar

Look up date from range1 in range2 -> If match then color cell


To organize my projects, I created a calendar in an Excel sheet.

The dates are not fixed and differ from project to project. Certain dates should be colored in different ways. I use conditional formatting, but I find CF to not always work as I want it to. Besides, since I do a lot of copying & pasting, the CF rules add up enormously over time, slowing down the worksheet. VBA might also be more flexible in the end.

I started with coloring the cell containing today's date. I modified code from another website.

Option Explicit

Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim Dates As Range
    Set Dates = Range("B2:H2," & _
                        "B6:H6")
                        
    For Each cell In Dates
    
        If Not IsDate(cell.Value) Then
        End If
    
        If IsEmpty(cell.Value) Then
        End If
        
        If cell.Value = Date Then
            cell.Interior.ColorIndex = 3
      
        'Include more conditions e.g. lookup date in list of holidays; if date = holiday then different color

        ElseIf cell.Value - Date <> 0 Then
            cell.Interior.ColorIndex = 0
        End If
 
    Next cell
End Sub

Now I'd like to compare the dates in the range.1 "Dates" with a list of other dates (range.2) (e.g. holidays). If a cell from "Dates" matches with a cell from range.2, the cell that matches is supposed to get another color.

I tried to do it manually by adding

ElseIf cell.Value = cell(1, 1).Value Then
    cell.Interior.ColorIndex = 2

However, this colors all cells, not only the cell that matches the date in cell(1, 1).


Solution

  • This is an example; the code checks values in ColA to values in ColB, and if a match is found, colors the cell in ColA, Change the references as desired.

    Dim xcel As Range
    Dim ycel As Range
    
    With Worksheets("Sheet1")
        For Each xcel In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
            For Each ycel In .Range("B1", .Cells(.Rows.Count, "B").End(xlUp))
                If xcel.Value = ycel.Value Then
                    xcel.Interior.Color = RGB(255, 255, 0)
                End If
            Next ycel
        Next xcel
    End With