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:

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


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

[TABLE="width: 392"]
<tbody>[TR]
[TD]SKU[/TD]
[TD]Bin Lagacy[/TD]
[TD]Bin AX[/TD]
[TD]Qty[/TD]
[/TR]
[TR]
[TD]000647[/TD]
[TD]BB6[/TD]
[TD]BB6[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]000647[/TD]
[TD]BB7[/TD]
[TD]BB7[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]000647[/TD]
[TD]BB8[/TD]
[TD]BB8[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]000647[/TD]
[TD]BB9[/TD]
[TD]BB9[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]000647[/TD]
[TD]BB10[/TD]
[TD]BB10[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]000655[/TD]
[TD]DA9[/TD]
[TD]DA9[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]000655[/TD]
[TD]DC9[/TD]
[TD]DC9[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]016406[/TD]
[TD]EM6[/TD]
[TD]EM6[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]016406[/TD]
[TD]EG2[/TD]
[TD]EG2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]016406[/TD]
[TD]EG3[/TD]
[TD]EG3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]016406[/TD]
[TD]EG4[/TD]
[TD]EG4[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]016406[/TD]
[TD]EG5[/TD]
[TD]EG5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]016406[/TD]
[TD]EG6[/TD]
[TD]EG6[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

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