after subtoals need to insert line below them and need to add a top border in excel vba-CodePudding

Dim iRange As Range
Dim iCells As Range

Set iRange = ThisWorkbook.ActiveSheet.UsedRange

For Each iCells In iRange
    'If Not IsEmpty(iCells) Then
    If iCells.SpecialCells(xlFormulas) = True Then
        iCells.BorderAround _
            LineStyle:=xlContinuous, _
            Weight:=xlThin
    End If
Next iCells

See Excel Image Here

CodePudding user response：

Please, try using the next code. No iteration needed:

Sub BordrsOnSubtotals()
   Dim sh As Worksheet, rngForm As Range
   
   Set sh = ActiveSheet
   On Error Resume Next 'for the case of no formulas in the sheet...
    Set rngForm = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
   On Error GoTo 0
   If Not rngForm Is Nothing Then
       rngForm.Offset(1).EntireRow.Insert xlShiftDown
       Intersect(rngForm.EntireRow, sh.UsedRange.EntireColumn).Borders(xlEdgeTop).Weight = 3
   End If
   'Excel inserts lines for the range Areas and the last two are in the same area and needs correction:
   sh.Range("A" & sh.rows.count).End(xlUp).Offset(-1).EntireRow.Delete
   Intersect(sh.Range("A" & sh.rows.count).End(xlUp).EntireRow, _
                  sh.UsedRange.EntireColumn).Borders(xlEdgeTop).Weight = 3
End Sub