Advanced Border Formatting

[Troy R]

I am currently working on a macro which formats horizontal lines either thin or medium depending on cell criteria of the leftmost column.

When the value of a cell in the leftmost column is different than the value of the cell below it , it places a medium thickness line between them. When the values are the same it draws a thin line.

It works fine when there are no filters applied, but it fails to take into account hidden rows.

Sub proFormatRows()

    Range("B2").Select
    Range(ActiveCell, ActiveCell.End(xlToRight)).Select
        
    Do Until ActiveCell.Value = 0
    
        If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
            proThinLine
        ElseIf ActiveCell.Value <> ActiveCell.Offset(1, 0).Value Then
            proMediumLine
        End If
        
        Selection.Offset(1, 0).Select
        
    Loop
    
End Sub

I've tried some complicated methods to solve this problem but the coding becomes too difficult as I am inexperienced with VBA.

I'm wondering if there is a simple way to compare a cell to the next visible cell below it?

 

[BrianB]

Not an easy job because we have to find the next visible row each time.
This seems to work OK.

'=================================================================================
'- MACRO TO COMPARE VISIBLE FILTERED ROWS AND FORMAT ACCORDINGLY
'- Brian Baulsom August 2007
'==================================================================================
Dim ws As Worksheet
Dim LastRow As Long
Dim LastCol As Integer
'- current cell
Dim CurrentRow As Long
Dim CurrentCell As Range
Dim FormatRange As Range        ' format row containing current cell
'- next visible cell for comparison
Dim NextRow As Long
Dim NextCell As Range

'==================================================================================
'- MAIN ROUTINE
'==================================================================================
Sub COMPARE_ROWS()
    Application.Calculation = xlCalculationManual
    '- initialise variables
    Set ws = ActiveSheet
    LastRow = ws.Range("B65536").End(xlUp).Row
    LastCol = ws.UsedRange.Columns.Count
    '-------------------------------------------------------------------------------
    '- remove any existing bottom lines
    With ws.Range(Cells(2, 1), Cells(LastRow, LastCol))
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    '--------------------------------------------------------------------------------
    '- get first visible row (excluding row 1)
    CurrentRow = 1
    FindNextVisibleRow
    CurrentRow = NextRow
    '--------------------------------------------------------------------------------
    '- loop rows
    While NextRow < LastRow
        FindNextVisibleRow
        Set FormatRange = ws.Range(Cells(CurrentRow, 1), Cells(CurrentRow, LastCol))
        '----------------------------------------------------------------------------
        '- compare cells
        If CurrentCell.Value = NextCell.Value Then
            FormatRange.Borders(xlEdgeBottom).Weight = xlThin
        Else
            FormatRange.Borders(xlEdgeBottom).Weight = xlMedium
        End If
        '----------------------------------------------------------------------------
        '- set next row for comparision
        CurrentRow = NextRow
    Wend
    '---------------------------------------------------------------------------------
    '- finish
    MsgBox ("Done")
    Application.Calculation = xlCalculationAutomatic
End Sub
'========== END OF MAIN ROUTINE ======================================================

'=====================================================================================
'- SUBROUTINE CALLED FROM MAIN ROUTINE : FIND NEXT VISIBLE ROW
'=====================================================================================
Private Sub FindNextVisibleRow()
    Set CurrentCell = ws.Cells(CurrentRow, "B")
    '-----------------------------------------------
    For NextRow = CurrentRow + 1 To LastRow
        If ws.Rows(NextRow).Hidden = False Then
            Set NextCell = ws.Cells(NextRow, "B")
            Exit Sub
        End If
    Next
End Sub
'========== END OF SUBROUTINE ========================================================