Itemising individual items from a totals table

SuzB17

New Member
Joined
Oct 17, 2019
Messages
5
Hi,
We have a table that a list of furniture types in it and the total number of that type in each room in a building. I want to be able to create a list that itemises every piece of furniture individually. (Although furniture may be the same type they may have different finishes and therefore need to be listed out individually). This is sort of the opposite of COUNT / COUNTIFS. I ideally need to get from this:

Level 00
typedescriptioncode00A00B00C00D00E00F
seatinglounge chairCH-0038001000
seatinghigh back stoolCH-007040020
seatingstoolCH-010022400

<tbody>
</tbody>

to this

typedescriptioncodelevelzone
seatinglounge chairCH-0030000A
seatinglounge chairCH-0030000A
seatinglounge chairCH-0030000A
seatinglounge chairCH-0030000A
seatinglounge chairCH-0030000A
seatinglounge chairCH-0030000A
seatinglounge chairCH-0030000A

<tbody>
</tbody>


Effectively we have been given a list of furniture requirements from a client and we now need to be able to expand this list out to add further detail to each individual item. Is there an easy way to do this usuing formulas or am I looking at VBA? I've used VBA before but a while ago and I am still pretty much a newbie to it. We're trying to avoid listing this out manually as there is a risk of error and there is quite a list.

Thanks in advance.
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Hi SuzB17,
something like this should work, you might want to change the ranges etc.
Cheers,
Koen

Code:
Sub ItemizeList()

Set Sht = Worksheets("ABC")
Set ValueRange = Sht.Range("D3:I5")
Set StartWriteRng = Worksheets("Result").Range("A2")
ResultNr = 0

'Loop through all values in the range
For Each Cl In ValueRange
    'Only do something if there is a value > 0
    If Cl.Value > 0 Then
        ClRow = Cl.Row
        ClCol = Cl.Column
        NrRws = Cl.Value
        
        StartWriteRng.Offset(ResultNr, 0).Resize(NrRws, 1).Value = Sht.Cells(ClRow, 1).Value
        StartWriteRng.Offset(ResultNr, 1).Resize(NrRws, 1).Value = Sht.Cells(ClRow, 2).Value
        StartWriteRng.Offset(ResultNr, 2).Resize(NrRws, 1).Value = Sht.Cells(ClRow, 3).Value
        StartWriteRng.Offset(ResultNr, 3).Resize(NrRws, 1).Value = Sht.Range("C1").Value
        StartWriteRng.Offset(ResultNr, 4).Resize(NrRws, 1).Value = Sht.Cells(2, ClCol).Value
        
        ResultNr = ResultNr + NrRws
    End If
Next Cl

'Clean up variables
Set Sht = Nothing

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top