CODEWITHSUNDEEP
excelvba
Princey
Princey

Reputation: 35

Looping through all worksheets issue

I have a long macro which has the following at the end of it:

        On Error Resume Next

    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        Do
        If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
            Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
            iRow = iRow + 2
        Else
            iRow = iRow + 1
        End If
        Loop While Not Cells(iRow, iCol).Text = ""

        ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).ClearFormats

    Next ws

This SHOULD add a blank row when there is a change in column B (to seperate groups of data) and then remove the formatting on the blank row.

This does not seem to loop through all the worksheets correctly as only the first sheet is changed to include a blank row after a change in column B. It is also very slow.

I was hoping I could get some assistance with this, and perhaps a better resolution that is faster?

Thank you in advance for your assistance.

Upvotes: 0

Views: 99

Answers (2)

DisplayName
DisplayName

Reputation: 13386

As jsheeran commented, you have to initialize iRow at each new sheet you are looping

One way to do it is looping backwards from last not empty cell row in column iCol to its second one, which also simplifies the code:

For Each ws In ActiveWorkbook.Worksheets
    With ws
        For iRow = .Cells(.Rows.Count, iCol).End(xlUp) To 2 Step - 1
            If .Cells(iRow - 1, iCol) <> .Cells(iRow, iCol) Then .Cells(iRow, iCol).EntireRow.Insert Shift:=xlDown
        Next
        On Error Resume Next
        .UsedRange.SpecialCells(xlCellTypeBlanks).ClearFormats
        On Error GoTo 0
    End With
Next

Upvotes: 1

BruceWayne
BruceWayne

Reputation: 23283

When looping through sheets, you must make positive you are adding the worksheet reference when referencing ranges. Otherwise, any range reference will refer to whatever the ActiveSheet happens to be.

On Error Resume Next

For Each ws In ThisWorkbook.Worksheets
    With ws
        Do
            If .Cells(iRow + 1, iCol) <> .Cells(iRow, iCol) Then
                .Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
                iRow = iRow + 2
            Else
                iRow = iRow + 1
            End If
        Loop While Not .Cells(iRow, iCol).Text = ""
        .UsedRange.SpecialCells(xlCellTypeBlanks).ClearFormats
    End With
Next ws

Upvotes: 3

Related Questions