Expand product codes to include sub-codes

[MPH88]

I have a product numbers in a column A like this:

	A
1	40
2	42
3	5403
4	9519

<tbody>
</tbody>

Product numbers can be one to four numerals. Each product can have up to 9 sub-codes. For example: 40-1, 42-5, 9519-8.

Can I use a macro to quickly expand this list and give me all the possible sub-codes, like this?

	C
1	40
2	40-1
3	40-2
4	40-3
5	40-4

<tbody>
</tbody>

And so on for all the variations.

Thanks!

 

[Joe4]

Try this:

Sub ExpandCodes()

    Dim lr As Long, r As Long, s As Long
    Dim v As Variant
    
    Application.ScreenUpdating = False
    
'   Find last cell in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows backwards
    For r = lr To 1 Step -1
        v = Cells(r, "A")
        Rows(r + 1 & ":" & r + 8).Insert
        For s = 1 To 8
            Cells(r + s, "A") = v & "-" & s
        Next s
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[MPH88]

This is perfect! Thanks so much.

 

[Joe4]

You are welcome.

 

[Rick Rothstein]

In case you might be interested, here is another macro that you can consider...

[table="width: 500"]
[tr]
	[td]Sub CodesSubCodes()
  Dim Arr As Variant
  With Range("A1", Cells(Rows.Count, "A").End(xlUp))
    Arr = Application.Transpose(Split(Join(Application.Transpose(Evaluate(Replace("IF({1},@&"" ""&@&""-1 ""&@&""-2 ""&@&""-3 ""&@&""-4 ""&@&""-5 ""&@&""-6 ""&@&""-7 ""&@&""-8 ""&@&""-9 "")", "@", .Address))), "")))
    With .Cells(1).Resize(UBound(Arr))
      .NumberFormat = "@"
      .Value = Arr
    End With
  End With
End Sub[/td]
[/tr]
[/table]

 

[MPH88]

Thank you. That works well, too!