Excel loop hangs after trying to manipulate data (VBA)

Question

I have written a simple nested for loop in VBA that loops through records in my worksheet and, if it finds some values on basis of conditions, copies the value in the current worksheet.

The values of NumRows and NumRowSTGSales are 4000 and 8000 respectively. When I run the code, Excel just hangs

Dim curRowNo As Long
curRowNo = 2
NumRowSTGSales = Worksheets("Worksheet1").UsedRange.Rows.Count
' Set numrows = number of rows of data.
NumRows = Worksheets("Worksheet2").UsedRange.Rows.Count
' Select cell a1.

' Looping through GL accounts

'Looping through items in GL accounts
For y = 2 To NumRows
    'Looping through customer code found in sales data
    For z = 2 To NumRowSTGSales
        dataGL = Worksheets("Worksheet1").Cells(y, "A").Value
        dataItem = Worksheets("Worksheet1").Cells(y, "B").Value
        itemSales = Worksheets("Worksheet2").Cells(z, "F").Value
        If dataItem = itemSales Then
            dataCustomer = Worksheets("Worksheet2").Cells(z, "E").Value
            Worksheets("CurrentWorksheet").Cells(curRowNo, "A").Value = dataGL
            Worksheets("CurrentWorksheet").Cells(curRowNo, "B").Value = dataItem
            Worksheets("CurrentWorksheet").Cells(curRowNo, "C").Value = dataCustomer
            curRowNo = curRowNo + 1
        End If
    Next z
Next y

Answer 1

Thank you all for your useful answers, the final approach i used to solve this problem was to add a pivot table for the data i wanted to go through, i then dynamically added a filter in the pivot table for that particular item instead of looping through 1000's of records through code.

I then picked up each corresponding customer through the pivot table.

Sample code for the same is shown below:

Dim itemCustSalesWS As Worksheet
        Set itemCustSalesWS = ActiveWorkbook.Worksheets("Sales item customer pivot")
        Dim itemCustSalesPivot As PivotTable
        Set itemCustSalesPivot = itemCustSalesWS.PivotTables("Item Customer Pivot sales")
        itemCustSalesPivot.PivotFields("Item_Code").Orientation = xlPageField
        'Filtering here
        Dim pf As PivotField
        Set pf = Worksheets("Sales item customer pivot").PivotTables("Item Customer Pivot sales").PivotFields("Item_Code")
        With pf
        .ClearAllFilters
         .CurrentPage = dataItem
         End With

         With itemCustSalesWS.UsedRange
         itemCustfirstrow = .Row
         itemCustfirstcol = .Column
         itemCustlastrow = .Rows(UBound(.Value)).Row
         itemCustlastcol = .Columns(UBound(.Value, 2)).Column
        End With

        'The following loop runs for the current filtered item FROM SEQUENCE 1 IN SALES ITEM CUSTOMER PIVOT, and maps
        'their amount  in front of the GL accounts and items
        For z = 4 To itemCustlastrow - 1

        'Logic for calculation of Sequence 4 goes here
        dataCustomer = Worksheets("Sales item customer pivot").Cells(z, "A").Value
        sumItemCust = Worksheets("Sales item customer pivot").Cells(z, "B").Value

        Worksheets("Item customer mapping").Cells(curRowNo, "A").Value = dataGL
        Worksheets("Item customer mapping").Cells(curRowNo, "B").Value = dataItem
        Worksheets("Item customer mapping").Cells(curRowNo, "C").Value = dataCustomer
        Worksheets("Item customer mapping").Cells(curRowNo, "D").Value = seq1Amount
        Worksheets("Item customer mapping").Cells(curRowNo, "E").Value = volumePerItem
        Worksheets("Item customer mapping").Cells(curRowNo, "F").Value = sumItemCust

Thank you all for the help and quick responses.

Answer 2

The following code using VLookup function speeds up the process by a lot. I tested it, but I don't know exactly what types of data you are keeping in your Excel worksheets - can you upload a screen shot of the titles and 1-2 rows of data per worksheet, just to understand what types of data you have, and also the structure of the records tables.

Anyway, here is the piece of code I got:

Sub Compare_Large_Setup()


    Dim curRowNo                            As Long

    curRowNo = 2

    NumRowSTGSales = Worksheets("Worksheet1").UsedRange.Rows.count
    ' Set numrows = number of rows of data.
    NumRows = Worksheets("Worksheet2").UsedRange.Rows.count

    Dim VlookupRange                        As Range
    Dim result                              As Variant

    ' set Range of VLookup at Worksheet2
    Set VlookupRange = Worksheets("Worksheet2").Range("F2:F" & NumRows)

    'Looping through items in GL accounts
    For y = 2 To NumRowSTGSales
        On Error Resume Next
        result = Application.WorksheetFunction.VLookup(Worksheets("Worksheet1").Cells(y, "B"), VlookupRange, 1, False)

        ' no match was found with VLlookup >> advance 1 in NEXT loop
        If Err.Number = 1004 Then
            GoTo ExitFor:
        End If

        ' successful match found with VLookup function >> copy the records to "CurrentWorksheet" sheet
        Worksheets("CurrentWorksheet").Cells(curRowNo, "A").Value = Worksheets("Worksheet1").Cells(y, "A").Value
        Worksheets("CurrentWorksheet").Cells(curRowNo, "B").Value = result
        Worksheets("CurrentWorksheet").Cells(curRowNo, "C").Value = Application.WorksheetFunction.VLookup(Worksheets("Worksheet1").Cells(y, "B"), VlookupRange, 4, False)
        curRowNo = curRowNo + 1

ExitFor:
    Next y


End Sub

Answer 3

You missed a quotation mark in one of the lines. One quick fix, but probably not the solution to the problem is to add a 'DoEvents' in the loops to keep it from freezing.

Dim curRowNo As Long
curRowNo = 2
NumRowSTGSales = Worksheets("Worksheet1").UsedRange.Rows.Count
' Set numrows = number of rows of data.
NumRows = Worksheets("Worksheet2").UsedRange.Rows.Count
' Select cell a1.

' Looping through GL accounts

'Looping through items in GL accounts
For y = 2 To NumRows
    'Looping through customer code found in sales data
    For Z = 2 To NumRowSTGSales
        dataGL = Worksheets("Worksheet1").cells(y, "A").Value
        dataItem = Worksheets("Worksheet1").cells(y, "B").Value
        itemSales = Worksheets("Worksheet2").cells(Z, "F").Value
        If dataItem = itemSales Then
            dataCustomer = Worksheets("Worksheet2").cells(Z, "E").Value
            Worksheets("CurrentWorksheet").cells(curRowNo, "A").Value = dataGL
            Worksheets("CurrentWorksheet").cells(curRowNo, "B").Value = dataItem
            Worksheets("CurrentWorksheet").cells(curRowNo, "C").Value = dataCustomer
            curRowNo = curRowNo + 1
        End If
    DoEvents
    Next Z
DoEvents
Next y