Macro/VBA Copy several values from 1 row into new sheet with multiple rows

Hi guys,
I am using Office 2021 Mac on MPB with OS Monterey.

I have an excel where I have a single row for each of my main items. To the right I have calculated my re-packed 1, 2, 4, 8, 16 once items with the new price (see attachment tab MainItem).

For each main item and packaging size I need to create a single row in a new tab on the same excel (see attachment tab LoadItem).

On the new tab I have the main item with packing size 01, 02, 04, 08, 16 added and the associated price.

I want to use this new tab to update the sales prices of all my items in Quickbooks.

Can somebody suggest a macro or VBA I could use to create my load file?

Thanks in advance.
Gerd

Thank you very much for the VBA. And it sure IS working correctly.

I have 800+ items with their respective sales prices in the ItemLoad tab.

I applied the VBA to my main price list and make the necessary VBA changes. But I would need 2 more small changes.

1) I separate my main items groups with a blank row.
2) The last record in my Excel has value Totals in cell A.

I wanted to change the VBA To do the loop till it finds value Totals in A(X, 1), and skip any blank rows. My VBA changes trigger an error, I think my For statement is not allowed.

Would you mind having a look at my changes?

Thanks,
Gerd

Sub UpdateSalesPrice()

Dim a
a = Sheets("MainItem").[A1].CurrentRegion

ReDim b(1 To UBound(a) * 5, 1 To 3)
' For X = 7 To UBound(a)
For X = 7 To (a(X, 1) = "Totals") ' Checks for value Totals in cell A
If a(X, 1) <> "" Then ' Skips blank row
For y = 14 To 18
i = i + 1
b(i, 1) = a(X, 2) & Format(a(6, y), "00")
b(i, 2) = a(X, 5) & " " & a(6, y) & "oz"
b(i, 3) = a(X, y)
Next
End If
Next

With Sheets("ItemLoad").[A1].Resize(, 3)
.Parent.UsedRange.Clear
.Value = [{"QB Item","Description","Sales Price"}]
.Offset(1).Resize(i) = b
End With

End Sub

I should have copied a sample of my main price list (see attached sample excel)

I get an error where we assign the item number

Sub UpdateSalesPrice()

' Dim a
' a = Sheets("MainItem").[A1].CurrentRegion

Dim a, Lr As Long
With Sheets("MainItem")
Lr = .Range("A" & Rows.Count).End(xlUp).Row - 1
a = .[A1].Resize(Lr, 8)
End With

ReDim b(1 To UBound(a) * 5, 1 To 3)
For x = 7 To UBound(a)
If a(x, 1) <> "" Then
For y = 14 To 18
i = i + 1
b(i, 1) = a(x, 2) & Format(a(6, y), "00"). '<== This is where I get the error
b(i, 2) = a(x, 5) & " " & a(6, y) & "oz"
b(i, 3) = a(x, y)
Next
End If
Next

With Sheets("ItemLoad").[A1].Resize(, 3)
.Parent.UsedRange.Clear
.Value = [{"QB Item","Description","Sales Price"}]
.Offset(1).Resize(i) = b
End With

End Sub

After I have 18 columns in the excel I changed this statement. The sample I had provided only had 8 columns.

a = .[A1].Resize(Lr, 18)

But still get the error

I exited the excel then went back in. That seemed to have resolved my error.

With this VBA everything is working now.

Thanks again for your examples. I learned a lot.


Sub UpdateSalesPrice()

' Dim a
' a = Sheets("MainItem").[A1].CurrentRegion

Dim a, Lr As Long
With Sheets("MainItem")
Lr = .Range("A" & Rows.Count).End(xlUp).Row - 1
a = .[A1].Resize(Lr, 18)
End With

ReDim b(1 To UBound(a) * 5, 1 To 3)
For x = 7 To UBound(a)
If a(x, 1) <> "" Then
For y = 14 To 18
i = i + 1
b(i, 1) = a(x, 2) & Format(a(6, y), "00")
b(i, 2) = a(x, 5) & " " & a(6, y) & "oz"
b(i, 3) = a(x, y)
Next
End If
Next

With Sheets("ItemLoad").[A1].Resize(, 3)
.Parent.UsedRange.Clear
.Value = [{"QB Item","Description","Sales Price"}]
.Offset(1).Resize(i) = b
End With

End Sub