My VBA Macro crashes after changing one cell

Question

I am trying to make a Macro to collect data from one sheet of the Workbook (it contains output from another system) and arrange the data to make it readable on another sheet. It has been a long time since I last did any coding, so I looked over many tutorials before building it.

The macro is supposed to first zero out all the relevant cells in the "Inventory" sheet. Then it looks through the "Input" sheet and pulls out the relevant data. Unfortunately it macro crashes right after changing the value in the first cell.

I am probably making some rookie mistake in the syntax, but I cant seem to figure out what is wrong.

Sub Button1_Click()

Dim inv As Worksheet
Dim source As Worksheet
Dim productNum As String
Dim invI As Long
Dim sourceI As Long
Dim i As Long

Set inv = ThisWorkbook.Sheets("Inventory")
Set source = ThisWorkbook.Sheets("Input")

invI = 3
sourceI = 2
i = 3

With inv
Do Until productNum = "end"
    
    .Cells(i, 3) = 0
    .Cells(i, 4) = 0
    .Cells(i, 5) = 0
    .Cells(i, 6) = 0
    .Cells(i, 7) = 0
    .Cells(i, 8) = 0
    .Cells(i, 9) = 0
    .Cells(i, 10) = 0
    .Cells(i, 11) = 0
    .Cells(i, 12) = 0
    .Cells(i, 13) = 0
    .Cells(i, 14) = 0
    .Cells(i, 15) = 0
    .Cells(i, 16) = 0
    .Cells(i, 17) = 0
    .Cells(i, 18) = 0
    .Cells(i, 19) = 0
    .Cells(i, 20) = 0
    .Cells(i, 21) = 0
    .Cells(i, 22) = 0
    .Cells(i, 23) = 0
    .Cells(i, 24) = 0
    .Cells(i, 25) = 0
    .Cells(i, 26) = 0
    .Cells(i, 27) = 0
    .Cells(i, 28) = 0
    .Cells(i, 29) = 0
    .Cells(i, 30) = 0
            
    i = i + 1
    
    productNum = inv.Cells(i, 1).Value
    
Loop
End With



Do
    
    productNum = inv.Range("A" & invI).Value
    
    Do Until source.Range("A" & sourceI).Value = ""
    
       If productNum = source.Range("I" & sourceI).Value Then
        
            Select Case source.Range("A" & sourceI).Value
            Case Is = 10
                inv.Range("C" & invI) = source.Range("D" & sourceI).Value
                inv.Range("D" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 12
                inv.Range("E" & invI) = source.Range("D" & sourceI).Value
                inv.Range("F" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 13
                inv.Range("G" & invI) = source.Range("D" & sourceI).Value
                inv.Range("H" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 14
                inv.Range("I" & invI) = source.Range("D" & sourceI).Value
                inv.Range("J" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 15
                inv.Range("K" & invI) = source.Range("D" & sourceI).Value
                inv.Range("L" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 16
                inv.Range("M" & invI) = source.Range("D" & sourceI).Value
                inv.Range("N" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 20
                inv.Range("O" & invI) = source.Range("D" & sourceI).Value
                inv.Range("P" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 21
                inv.Range("Q" & invI) = source.Range("D" & sourceI).Value
                inv.Range("R" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 30
                inv.Range("S" & invI) = source.Range("D" & sourceI).Value
                inv.Range("T" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 31
                inv.Range("U" & invI) = source.Range("D" & sourceI).Value
                inv.Range("V" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 32
                inv.Range("W" & invI) = source.Range("D" & sourceI).Value
                inv.Range("X" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 40
                inv.Range("Y" & invI) = source.Range("D" & sourceI).Value
                inv.Range("Z" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 41
                inv.Range("AA" & invI) = source.Range("D" & sourceI).Value
                inv.Range("AB" & invI) = source.Range("C" & sourceI).Value
            
            Case Is = 51
                inv.Range("AC" & invI) = source.Range("D" & sourceI).Value
                inv.Range("AD" & invI) = source.Range("C" & sourceI).Value
            
            End Select
            
            sourceI = sourceI + 1
            
        End If
        
        invI = invI + 1
        
    Loop
    
Loop Until productNum = "end"


End Sub

Any help is GREATLY appreciated.

stupid question: did you try to use debugger, breakpoints and stepping through lines to identify where exactly the code crashes and look inside variables etc.? — L D, May 17 '22 at 18:48
To be honest not really. It seems to be crashing at `.Cells(i, 3) = 0` because that is the only edit that shows on the spreadsheet when I run the macro. It has been nearly a decade since I seriously programed so I am super rusty. — Jesse, May 17 '22 at 19:11
Excel has quite nice debugger, it can show you whether all the objects are properly accessible, what are their properties, try to work with them in Immediate console etc. the some little video about the debugger: https://www.youtube.com/watch?v=fsgOt9rxq5s — L D, May 17 '22 at 19:26
not related to your question, but you could replace _all_ of your `.Cells(i, 3) = 0` to `.Cells(i, 30) = 0` lines with this _one_ line `.Cells(i, 3).Resize(1, 28) = 0` — Spectral Instance, May 24 '22 at 20:05

Warcupine · Accepted Answer · 2022-05-17T19:37:49.573

If this line returns true Do Until source.Range("A" & sourceI).Value = ""

You never increment invI = invI + 1

That causes you to enter an infinite loop.

Move the incrementer to after the Loop

            End Select
            
            sourceI = sourceI + 1
            
        End If
    Loop
    invI = invI + 1
    
Loop Until productNum = "end"

Using for Loops your code would be:

    Dim inv As Worksheet
    Dim source As Worksheet
    Dim productNum As String
    Dim invI As Long
    Dim sourceI As Long
    Dim i As Long
    Dim j As Long
    Dim lr As Long
    
    Set inv = ThisWorkbook.Sheets("Inventory")
    Set source = ThisWorkbook.Sheets("Input")
    
    With inv
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(3, 3), .Cells(lr, 30)).Value = 0 'No need to loop you can assign all at once
        
        For i = 3 To lr
            productNum = .Cells(i, 3).Value
            For j = 2 To source.Cells(Rows.Count, 1).End(xlUp).Row
                If productNum = source.Cells(j, 9).Value Then
                    Select Case source.Cells(j, 1).Value
                    'You can shorten this by doing an offset of source.Cells(j, 1).Value to get the column
                    'It will make debugging harder but the code shorter
                        Case 10
                            inv.Range("C" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("D" & invI) = source.Range("C" & sourceI).Value
                        Case 12
                            inv.Range("E" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("F" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 13
                            inv.Range("G" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("H" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 14
                            inv.Range("I" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("J" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 15
                            inv.Range("K" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("L" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 16
                            inv.Range("M" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("N" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 20
                            inv.Range("O" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("P" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 21
                            inv.Range("Q" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("R" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 30
                            inv.Range("S" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("T" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 31
                            inv.Range("U" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("V" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 32
                            inv.Range("W" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("X" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 40
                            inv.Range("Y" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("Z" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 41
                            inv.Range("AA" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("AB" & invI) = source.Range("C" & sourceI).Value
                        
                        Case 51
                            inv.Range("AC" & invI) = source.Range("D" & sourceI).Value
                            inv.Range("AD" & invI) = source.Range("C" & sourceI).Value
                        
                    End Select
                End If
            Next j
        Next i
    End With

I suspect you need to reset `SourceI` before the start of the inner loop as well. — Warcupine, May 17 '22 at 18:59
Thank you for the fix but it is still crashing. judging by the output that I can see it dosent make it past `.Cells(i, 3) = 0` — Jesse, May 17 '22 at 19:04
Do you have a cell = "end" in Column A of Inventory? Really you should find the [last row](https://stackoverflow.com/questions/38882321/better-way-to-find-last-used-row) and do `for i = 3 to lastrow` instead of a `do loop` and you wouldn't run the risk of an infinite loop at all. — Warcupine, May 17 '22 at 19:11

My VBA Macro crashes after changing one cell

1 Answers1