Home > Back-end >  How to add borders to a dynamic range based on a certain condition?
How to add borders to a dynamic range based on a certain condition?

Time:12-21

I was wondering how I would go about adding borders (through a call procedure) to a range based on a certain condition. Using the image as an example, I would like to call my procedure that adds borders to the range spanning from columns A:D based on each instance of the Date of Occurrence, i.e. A5:D7 will share an outside border, A8:D10, A11:D12 etc. Below is my procedure that I would like to call, during a loop I would imagine, until the last cell of Column A is hit.

Sub add_outside_border()

With Selection
    .borders(xlEdgeLeft).LineStyle = xlContinuous
    .borders(xlEdgeTop).LineStyle = xlContinuous
    .borders(xlEdgeBottom).LineStyle = xlContinuous
    .borders(xlEdgeRight).LineStyle = xlContinuous
End With

End Sub

enter image description here

CodePudding user response:

Please, try the next code:

Sub testBoderArrowndData()
  Dim sh As Worksheet, lastR As Long, arr, i As Long, j As Long, boolLast As Boolean
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  j = 1
  For i = 5 To lastR
        If IsDate(sh.Range("A" & i).value) Then
            Do While Not IsDate(sh.Range("A" & i   j).value)
                j = j   1
                If i   j >= lastR Then boolLast = True: Exit Do 'for the last range
            Loop
            sh.Range("A" & i & ":D" & i   j - IIf(boolLast, 0, 1)).BorderAround xlContinuous, xlThick
            i = i   j - 1: j = 1
        End If
  Next i
End Sub
  • Related