VBA Code - Create a list on one sheet based on another spreadsheet, multiplying cells based on Values.

[BAQI]

I am looking for VBA code that does the following:

On sheet 1, I input information in columns A-H. In column H, I put the quantity.

On sheet 2, it creates a list, filling out the information in the appropriate columns. A new row of the same information for the quantity in Column H on sheet 1. I would also like it to delete all the information from row 2 on (only leaving the headers) before it does this task, so it only has the latest information from sheet 1.

I attached images of what I mean. Thank you!

 

[DanteAmor]

Try:

Sub CreateList()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, n As Long, lr As Long
  
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  sh2.Rows("2:" & Rows.Count).ClearContents
  
  lr = sh1.Range("C" & Rows.Count).End(3).Row
  a = sh1.Range("A2:H" & lr).Value
  n = WorksheetFunction.Sum(sh1.Range("H2:H" & lr))
  ReDim b(1 To n, 1 To 7)
  
  For i = 1 To UBound(a, 1)
    For j = 1 To a(i, 8)
      k = k + 1
      b(k, 1) = a(i, 3)
      b(k, 2) = a(i, 2)
      b(k, 3) = a(i, 1)
      b(k, 4) = a(i, 4)
      b(k, 5) = a(i, 6)
      b(k, 6) = a(i, 7)
      b(k, 7) = a(i, 5)
    Next
  Next
  
  sh2.Range("A2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  MsgBox "Finished"
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[BAQI]

Try:

Sub CreateList()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, n As Long, lr As Long
 
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  sh2.Rows("2:" & Rows.Count).ClearContents
 
  lr = sh1.Range("C" & Rows.Count).End(3).Row
  a = sh1.Range("A2:H" & lr).Value
  n = WorksheetFunction.Sum(sh1.Range("H2:H" & lr))
  ReDim b(1 To n, 1 To 7)
 
  For i = 1 To UBound(a, 1)
    For j = 1 To a(i, 8)
      k = k + 1
      b(k, 1) = a(i, 3)
      b(k, 2) = a(i, 2)
      b(k, 3) = a(i, 1)
      b(k, 4) = a(i, 4)
      b(k, 5) = a(i, 6)
      b(k, 6) = a(i, 7)
      b(k, 7) = a(i, 5)
    Next
  Next
 
  sh2.Range("A2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  MsgBox "Finished"
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

It appears I'm getting an "Subscript out of range" error when I step into this line: ReDim b(1 To n, 1 To 7)

 

[DanteAmor]

You can put here the data with which you are testing. Use the XL2BB tool, it is assumed that the Qtys are in column H, if they are in another column or column H is empty, then the macro will not work.

 

[BAQI]

You can put here the data with which you are testing. Use the XL2BB tool, it is assumed that the Qtys are in column H, if they are in another column or column H is empty, then the macro will not work.


View attachment 97323

I don't know why that didn't occur to me. Thank you!