Home > Blockchain >  My VBA Macro crashes after changing one cell
My VBA Macro crashes after changing one cell

Time:05-18

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.

CodePudding user response:

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
  • Related