CODEWITHSUNDEEP
excelvbadata-analysisdata-manipulation
Joe6.626070
Joe6.626070

Reputation: 319

Single VBA For Each Looping Through Worksheets In Workbook Multiple Times

I have a VBA script in an excel workbook that loops through a large number of sheets (around 100) to merge data onto a single sheet. This is also data exported from PDF files. I tried to clean all non-printable characters and formatting but I'm not sure if I missed some.

It uses a single For Each ws In Workbook loop but when executed the script loops through the workbook a seemingly random number of times and stops at a seemingly random worksheet. This causes a problem because sometimes when executed, the summary become 10K lines instead of 1K.

Does anyone have any idea why this is happening?

Since the data is imported from a PDF, it is not formatted in a useful way. I have other scripts that get me to this point where I can merge and use power query. Layout of each worksheet is:

|------|---------------|---------|--------------|----------|
| Buy  |  Description  |  Symbol |   Price ($)  |  null    |
| null |  Lrg Co       |  VOO    |   $242.55    | 1/2/2018 |
| cont....

And the VBA Code (Not the prettiest but gets the job done... almost ):

Sub summarize()
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim i As Integer
    Dim stcol As Integer
    Dim endcol As Integer
    Dim strow As Integer
    Dim endrow As Integer
    Dim symrng As Range
    Dim totrow As Integer
    Dim j As Integer
    Dim itm As Range
    Dim lr As Long
    
    j = 1
    
    For Each ws In Worksheets
        stcol = 1       
        Set symrng = ws.Cells.Find("Symbol", LookAt:=xlPart, MatchCase:=False)      
        strow = symrng.Row      
        endcol = symrng.Offset(1, 0).End(xlToRight).Column     
        endrow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
        Set symrng = Nothing
        totrow = endrow - strow
        
        For i = 0 To totrow
            Worksheets("Summary").Range(Worksheets("Summary").Cells(j + 1, 1), Worksheets("Summary").Cells(j + 1, endcol)).Value = itm.Value
            j = j + 1
        Next i
    Next ws
    
    Application.ScreenUpdating = True

End Sub

Upvotes: 1

Views: 432

Answers (1)

Joe6.626070
Joe6.626070

Reputation: 319

Thank you @FoxFireBurnsandBurns for the idea, I ran the script with only a few sheets. I wasn't testing for the Summary so it kept iterating through the imported data until I'm guessing excel triggered a memory circuit breaker. Adding this line fixed it:

If ws.Name = "Summmary" Then GoTo Nextws:

The complete code is:

Sub summarize()
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim i As Integer
    Dim stcol As Integer
    Dim endcol As Integer
    Dim strow As Integer
    Dim endrow As Integer
    Dim symrng As Range
    Dim totrow As Integer
    Dim j As Integer
    Dim itm As Range
    Dim lr As Long
    
    j = 1
    
    For Each ws In Worksheets
        ' Exclude Summary Sheet
        If ws.Name = "Summmary" Then GoTo Nextws:

        stcol = 1       
        Set symrng = ws.Cells.Find("Symbol", LookAt:=xlPart, MatchCase:=False)      
        strow = symrng.Row      
        endcol = symrng.Offset(1, 0).End(xlToRight).Column     
        endrow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
        Set symrng = Nothing
        totrow = endrow - strow
        
        For i = 0 To totrow
            Worksheets("Summary").Range(Worksheets("Summary").Cells(j + 1, 1), Worksheets("Summary").Cells(j + 1, endcol)).Value = itm.Value
            j = j + 1
        Next i
Nextws:
    Next ws
    
    Application.ScreenUpdating = True

End Sub

Upvotes: 2

Related Questions