November 29, 2008

Inserting Rows At Column Differences

The following code might be useful. You can use it to insert rows, lines or pagebreaks where values change in a column by changing one line of code.

Sub InsertRowsAtColumnDifferences()
    Dim lStartRow As Long
    Dim lLastRow As Long
    Dim lCounter As Long

    On Error Resume Next

    If ActiveWorkbook Is Nothing Then Exit Sub

    If TypeName(Selection) <> "Range" Then Exit Sub

    With Selection

        lStartRow = .Row

        lLastRow = lStartRow + .Columns(1).Cells.Count - 1

        For lCounter = lLastRow To lStartRow Step -1

            If Cells(lCounter, .Column).Value <> Cells(lCounter, .Column).Offset(1).Value Then

                If Cells(lCounter, .Column).Value <> "" And Cells(lCounter, .Column).Offset(1).Value <> "" Then

                    Cells(lCounter, .Column).Offset(1).EntireRow.Insert 'insert rows
                    
                    '.Rows(lCounter - lStartRow + 1).Borders(xlEdgeBottom).LineStyle = xlContinuous 'add lines
                    
                    'ActiveSheet.HPageBreaks.Add Before:=Cells(lCounter, .Column).Offset(1) 'add pagebreaks

                End If

            End If

        Next lCounter

    End With

    On Error GoTo 0
End Sub

I will be adding and other code this to my utilities in the near future. But I would like to hear from your ideas too.

What new tools would you like to see? Are there any repetitous or tiresome tasks you perform that could be made eaiser? (Housework and taking out the garbage not included!)

Send me an email (look on the left of this blog for the address). If you can suggest something that might be useful for a large number of Excel users, I want to hear from you :-)  

Posted by andrewe at 09:59