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