VBA "For Each" code for left border formatting in 366 columns-CodePudding

I have been searching the net all over, but I can't find any solution for this. There must be a way to drastically shorten this VBA code (se below). Cells in row 4, starting with H4, is related to cells in row 5, holding dates. If H5 is the first day of the month, H4 has value "Ja" (Swedish for "Yes"). If the statement is TRUE, then range H7:H106 should get a black left border, and if FALSE, the same range should get a white left border. In my code, I have to use defined ranges and unique cell references. The thing is, I need this code for 365 columns! Here's my version:

Sub FirstDayLine()

Dim r1, r2, r3, r4, r5 As Range

Set r1 = Range("H7:H106")
Set r2 = Range("I7:I106")
Set r3 = Range("J7:J106")
Set r4 = Range("K7:K106")
Set r5 = Range("L7:L106")

If Range("H4").value = "Ja" Then
r1.Borders(xlEdgeLeft).color = vbBlack
Else
r1.Borders(xlEdgeLeft).color = vbWhite
End If

If Range("I4").value = "Ja" Then
r2.Borders(xlEdgeLeft).color = vbBlack
Else
r2.Borders(xlEdgeLeft).color = vbWhite
End If

If Range("J4").value = "Ja" Then
r3.Borders(xlEdgeLeft).color = vbBlack
Else
r3.Borders(xlEdgeLeft).color = vbWhite
End If

If Range("K4").value = "Ja" Then
r4.Borders(xlEdgeLeft).color = vbBlack
Else
r4.Borders(xlEdgeLeft).color = vbWhite
End If

If Range("L4").value = "Ja" Then
r5.Borders(xlEdgeLeft).color = vbBlack
Else
r5.Borders(xlEdgeLeft).color = vbWhite
End If

End Sub

I know this all could be solved by some "For Each"-coding, but I can't get it right.

CodePudding user response：

With a For Each loop as you mention, plus Intersect:

Dim cell As Range
For Each cell in Range("I4:L4")
    Dim rng As Range
    Set rng = Intersect(cell.EntireColumn, Rows("7:106"))

    If cell.Value = "Ja" Then
        rng.Borders(xlEdgeLeft).color = vbBlack
    Else
        rng.Borders(xlEdgeLeft).color = vbWhite
    End If
Next

Though, as mentioned in comments, this is easily achievable just with conditional formatting.