CODEWITHSUNDEEP
exceldynamicbordervba
Kavorka
Kavorka

Reputation: 376

Ouside borders dynamic ranges

I have searched for my answer and have had no luck. What I am looking to do is move the bottom border I currently have 8 sets of data on one page. Ranges are B4:E7, G4:I7, B11:E14, G11:I14, B18:E40, G18:I40, G44:E66, and G44:I66. I have the border set in the template and I have VBA to hide cells if there is no value present.

I am looking to macro in the bottom border as the ranges have data. I have tried naming the ranges and using borderaround but that keeps to the original named range. I have found no code that is useful.

Upvotes: 0

Views: 358

Answers (2)

Kavorka
Kavorka

Reputation: 376

I was able to find an answer and have tested it. 

With Range("s_" & i)  
    With .Rows(.SpecialCells(xlCellTypeVisible).Rows.Count)   
        With .Borders(xlEdgeBottom)  
            .LineStyle = xlContinuous  
            .Weight = xlMedium  
            .ColorIndex = xlAutomatic  
        End With  
    End With  
End With

Upvotes: 0

pheeper
pheeper

Reputation: 1527

I wrote the module below which does exactly what you had asked for. I just noticed your answer, but from your question it seemed like you were looking for something more dynamic, not just the code to add a border. Just as an FYI, in the future you can use the macro record to get code like that. 

Sub DynamicBorders()

Dim arrRange1() As String
Dim arrRange2() As String
Dim i As Integer, x As Integer
Dim strLeft As String
Dim strRight As String

arrRange1 = Split("B4,G4,B11,G11,B18,G18,B44,G44", ",")
arrRange2 = Split("E7,I7,E14,I14,E40,I40,E66,I66", ",")

For i = LBound(arrRange1) To UBound(arrRange1)
    'Determine if the range is 2 or 3 charaters long, then set x = row number
    If Len(arrRange2(i)) = 2 Then
      x = Right(arrRange2(i), 1)
    ElseIf Len(arrRange2(i)) = 3 Then
      x = Right(arrRange2(i), 2)
    End If

    If ActiveSheet.Rows(x).Hidden = True Then
      'Find the first row that is not hidden
      Do Until ActiveSheet.Rows(x).Hidden = False
        x = x - 1
      Loop

      'Get the column letter of the range
      strLeft = Left(arrRange1(i), 1)
      strRight = Left(arrRange2(i), 1)

      'Select the range of cells across the bottom and set the border to black
      ActiveSheet.Range(ActiveSheet.Cells(x, strLeft), ActiveSheet.Cells(x, strRight)).Select
      With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = vbBlack
        .TintAndShade = 0
        .Weight = xlThin
      End With

    Else
      'If the last row is not hidden, then clear any previous border that was added
      'Note - you may want to add this as a seperate module to 'reset' the borders
      strLeft = arrRange1(i)
      strRight = arrRange2(i)
      ActiveSheet.Range(strLeft & ":" & strRight).Select
      Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    End If

  Next i

  ActiveSheet.Range("A1").Select
  End Sub

Upvotes: 1

Related Questions