Generate a list of products and locations in a new sheet based on the value from a cell

[Ianmaggy]

Hi,

Trying to build an inventory count sheet and I would like to automate the process of adding lines to a sheet when we have 1 product in more than 1 location. Pay attention the the "Bin" column.

Here is what my source data looks like:

Row#	Warehouse	SKU	Description	QTY	Cost	Bin	AX_SKU	BinAX	Multi bin
9	04	000647	H LT225/75R16 115R BR BLIZZAK	16	165.72	BB6-10	000647BRID	NULL	TRUE
15	04	000655	H LT275/70R18 125R BR BLIZZAK	24	187.64	DA9,DC9	000655BRID	NULL	TRUE
247	04	016406	H 255/70R17 112S BR BLIZZAK	28	151.88	EM6,EG2-6	016406BRID	NULL	TRUE

<tbody>
</tbody>

Here is how I would like the output to look like.

SKU	Bin Lagacy	Bin AX	Qty
000647	BB6	BB6
000647	BB7	BB7
000647	BB8	BB8
000647	BB9	BB9
000647	BB10	BB10
000655	DA9	DA9
000655	DC9	DC9
016406	EM6	EM6
016406	EG2	EG2
016406	EG3	EG3
016406	EG4	EG4
016406	EG5	EG5
016406	EG6	EG6

<tbody>
</tbody>

Thanks to anyone who can help me!

Ian

 

[MickG]

Based on your current data, try this for results on sheet2

[COLOR="Navy"]Sub[/COLOR] MG06Oct36
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n, Sp [COLOR="Navy"]As[/COLOR] Variant, Sp1 [COLOR="Navy"]As[/COLOR] Variant, nn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("G2"), Range("G" & Rows.Count).End(xlUp))
c = 1
ReDim Ray(1 To 4, 1 To 1)
Ray(1, c) = "SKU": Ray(2, c) = "Bin Lagacy": Ray(3, c) = "Bin AX": Ray(4, c) = "Qty"
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Value, ",")
        [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
            Sp1 = Split(Sp(n), "-")
                [COLOR="Navy"]If[/COLOR] InStr(Sp(n), "-") [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]For[/COLOR] nn = Mid(Sp1(0), 3, Len(Sp1(0)) - 2) To Sp1(1)
                        c = c + 1
                        ReDim Preserve Ray(1 To 4, 1 To c)
                        Ray(1, c) = Dn.Offset(, -4).Value
                        Ray(2, c) = Left(Sp1(0), 2) & nn
                        Ray(3, c) = Left(Sp1(0), 2) & nn
                    [COLOR="Navy"]Next[/COLOR] nn
                [COLOR="Navy"]Else[/COLOR]
                     c = c + 1
                     ReDim Preserve Ray(1 To 4, 1 To c)
                     Ray(1, c) = Dn.Offset(, -4).Value
                     Ray(2, c) = Sp(n)
                     Ray(3, c) = Sp(n)
                [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 4)
    .Value = Application.Transpose(Ray)
    .Borders.Weight = 2
    .Columns.AutoFit
    .HorizontalAlignment = xlCenter
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Peter_SSs]

Pretty similar to Mick's really, but a few variations.
Test with a copy of your workbook.

Sub Rearrange()
  Dim a As Variant, b As Variant, bits As Variant
  Dim i As Long, j As Long, k As Long, r As Long
  Dim Pref As String
  
  a = Application.Index(Cells, Evaluate("row(2:" & Range("G" & Rows.Count).End(xlUp).Row & ")"), Array(3, 7))
  ReDim b(1 To Rows.Count - 1, 1 To 3)
  For i = 1 To UBound(a)
    bits = Split(a(i, 2), ",")
    For j = 0 To UBound(bits)
      Pref = Left(bits(j), 2)
      For k = Split(Mid(bits(j), 3) & "-" & Mid(bits(j), 3), "-")(0) To Split(Mid(bits(j), 3) & "-" & Mid(bits(j), 3), "-")(1)
        r = r + 1
        b(r, 1) = a(i, 1): b(r, 2) = Pref & k: b(r, 3) = b(r, 2)
      Next k
    Next j
  Next i
  With Sheets.Add(After:=ActiveSheet).Range("A2:C2").Resize(r)
    .Columns(1).NumberFormat = "@"
    .Value = b
    .Rows(0).Resize(, 4).Value = Array("SKU", "Bin Lagacy", "Bin AX", "Qty")
  End With
End Sub