CODEWITHSUNDEEP
excelvba
Oybek
Oybek

Reputation: 29

For Each not looping on all sheets of a workbook

I'd like to clean up and reshape multiple Excel files in a folder. My Excel files have at least 2 sheets in each or more. My transformation tasks are as follows:

  1. To check each workbook if there is a sheet in it with the name "Block", if so, delete it;
  2. To delete any hidden sheets;
  3. Sheets with other names:
    3.1. Unmerge all cells of the sheets,
    3.2. Copy unmerged cell data of UsedRange,
    3.3. Special Paste/Transpose the copied data below the last used row of the same sheet,
    3.4. Delete the original data which was there before copying the UsedRange,
    3.5. Delete the columns starting from the 4th one until the column with specific header name

My problem is:

If there are more than one sheet in a workbook with the name "Block" (which needs to be deleted) or there are more than one sheet with different than "Block" names (which needs to be kept and transformed), the code stops its flow on that workbook and breaks. However, if I remove the last task (3.5 above) from the code, it goes smoothly or even with the last task (3.5) it still accomplishes the task if there is only one sheet with the name "Block" and one sheet with different name in a workbook. So, in my opinion, probably it is due to incorrect reference of Lastcolumn variable which I could not figure out how to correct it. My VBA code is similar to:

Public Sub preparereports()
    Dim MyFSO As FileSystemObject
    Dim MyFolder As folder
    Dim MySubfolder As folder
    Dim wb As Object
    Dim ws As Worksheet

    Set MyFSO = New FileSystemObject
    folderPath = ThisWorkbook.Worksheets(1).Range("A2").Value
    Set folder = MyFSO.GetFolder(folderPath)

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
        .AskToUpdateLinks = False
    End With

    For Each wb In folder.Files
        If Right(wb.Name, 3) = "xls" Or Right(wb.Name, 4) = "xlsx" Then
            Set masterWB = Workbooks.Open(wb)
            For Each ws In masterWB.Worksheets
                If Left(ws.Name, 5) = "Block" Or ws.Visible = xlSheetHidden Then
                    ws.Delete
                Else
                    ws.Cells.UnMerge
                    ws.Cells.ClearFormats
                    ws.UsedRange.Copy
                    Lastrow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
                    ws.Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues, Transpose:=True
                    Application.CutCopyMode = False
                    ws.Range("A1" & ":A" & Lastrow).EntireRow.Delete
                    Lastcolumn = Application.WorksheetFunction.Match("Write offs", ws.Rows(1), 0)
                    ws.Range(Cells(, 5), Cells(, Lastcolumn - 1)).EntireColumn.Delete
                 End If
            Next ws
            ActiveWorkbook.Close True
        End If
    Next

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
        .AskToUpdateLinks = True
    End With
End Sub

Upvotes: 0

Views: 82

Answers (1)

Notus_Panda
Notus_Panda

Reputation: 2810

You're deleting your header row at ws.Range("A1 & :A" & Lastrow).EntireRow.Delete since you put your Lastrow to .End(xlUp).row +1 so you copy paste the full UsedRange but delete the first line again with that.

Then Lastcolumn probably can't find Write offs because of that and can't delete anything properly.

This is what I use for Lastcolumn:

lColumn = wsA.Cells(1, Columns.Count).End(xlToLeft).Column

But of course change your row deletion to if you want to keep your headers:

ws.Range("A1 & :A" & Lastrow -1).EntireRow.Delete

Let me know if that works.

Upvotes: 0

Related Questions