Macro to iterate through Columns, Move to new worksheet then add 2 Columns.

[emzipoo4u]

Hi, I need help with macro to Automate the following.

Column A-D is static data.
Column E onwards lists part numbers as comma separated values for different product groups (the amount of columns and rows can vary and so can product group names)
I need to achieve the following.

Loop/iterate through the columns E onwards
If there is data in the column then copy A-D and focused column to a new worksheet.
Add a column with a formula to count the number of comma delimited products in the column (=IF(P2="","0",(LEN(TRIM(P2))-LEN(SUBSTITUTE(TRIM(P2),",",""))+"1")))
Add another column which will be D2/Result above
Paste the values
Separate the comma delimited values into new columns.


Example Raw Data

ID (A)	Make (B)	Model (C)	VIO (D)	Switches (E)	Sensors (F)	Brake Components (G)
1	Ford	Fiesta	12548	85421, 44457, 74544	99875, 45125
2	Vauxhall	Astra	89712	89842		98751, 54547, 54548

Result

Worksheet1 - Raw Data

Worksheet2 - Switches

ID	Make	Model	VIO	VIO Divided by Count	Count of product	Switches
1	Ford	Fiesta	12548	=12548/3	3	85421	44457	74544
2	Vauxhall	Astra	89712	=89712/1	1	89842

Worksheet3 - Sensors

ID	Make	Model	VIO	VIO Divided by Count	Count of Product	Sensors
1	Ford	Fiesta	12548	=12548/2	2	99875	45125
2	Vauxhall	Astra	89712	(=IFERROR(D3/E3,0))	0

Worksheet4 - Brake Components

ID	Make	Model	VIO	VIO Divided by Count	Count of Product	Brake Components
1	Ford	Fiesta	12548	=12548/0	0
2	Vauxhall	Astra	89712	=89712/3	3	98751	54547	54548

 

[DanteAmor]

Welcome to the MrExcel Message Board!

Try this:

Sub iterate_through_Columns()
  Dim sh As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long, lr As Long, k As Long
  Dim xProducts As Variant, pd As Variant
  
  Set sh = Sheets("Data")   'raw data
  lr = sh.Range("A" & Rows.Count).End(3).Row
  a = sh.Range("A1:D" & lr).Value2
  b = sh.Range("E1", sh.Cells(lr, sh.Cells(1, Columns.Count).End(1).Column)).Value2
  ReDim c(1 To UBound(a), 1 To 1000)
  
  For j = 1 To UBound(b, 2)
    Set sh2 = Sheets.Add(, Sheets(Sheets.Count))
    sh2.Name = b(1, j)
    sh2.Range("A1").Resize(UBound(a), 4).Value = a
    c(1, 1) = "VIO Divided by Count"
    c(1, 2) = "Count of product"
    c(1, 3) = b(1, j)
    For i = 2 To UBound(b, 1)
      If b(i, j) = "" Then
        c(i, 1) = 0
        c(i, 2) = 0
      Else
        xProducts = Split(b(i, j), ",")
        c(i, 1) = a(i, 4) / (UBound(xProducts) + 1)
        c(i, 2) = UBound(xProducts) + 1
        k = 3
        For Each pd In xProducts
          c(i, k) = pd
          k = k + 1
        Next
      End If
    Next i
    sh2.Range("E1").Resize(UBound(a), 1000).Value = c
  Next j
End Sub

 

[emzipoo4u]

Thank You DanteAmor - wow that is excellent and works super quick, I am unbelievably impressed
The counting is working as expected but when running it on more data the we seem to end up with extra parts ? Not sure what is happening but run on the below example and we get extra products on Brake Components worksheet (there should be 2 and 3 and we get 4 for both ID's). Any ideas ?

ID	Make	Model	VIO	Switches	Sensors	Brake Components	Wheels	Ignition	Bearings
1	VW	BEETLE	5081	45030	32700, 32520, 32650, 32700V	54190, 54180	57110S, 57050S,57030
2	MG	MGB	5006	43720, 43710	32560, 32580, 32560V,32580V	54140, 54720, 54750	57540, 57510	25951

 

[DanteAmor]

I forgot to clean an array. Try the following:

Sub iterate_through_Columns()
  Dim sh As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long, lr As Long, k As Long
  Dim xProducts As Variant, pd As Variant
  
  Application.ScreenUpdating = False
  Set sh = Sheets("Data")   'raw data
  lr = sh.Range("A" & Rows.Count).End(3).Row
  a = sh.Range("A1:D" & lr).Value2
  b = sh.Range("E1", sh.Cells(lr, sh.Cells(1, Columns.Count).End(1).Column)).Value2
  ReDim c(1 To UBound(a), 1 To 1000)
  
  For j = 1 To UBound(b, 2)
    Erase c
    ReDim c(1 To UBound(a), 1 To 1000)
    Set sh2 = Sheets.Add(, Sheets(Sheets.Count))
    sh2.Name = b(1, j)
    sh2.Range("A1").Resize(UBound(a), 4).Value = a
    c(1, 1) = "VIO Divided by Count"
    c(1, 2) = "Count of product"
    c(1, 3) = b(1, j)
    For i = 2 To UBound(b, 1)
      If b(i, j) = "" Then
        c(i, 1) = 0
        c(i, 2) = 0
      Else
        xProducts = Split(b(i, j), ",")
        c(i, 1) = a(i, 4) / (UBound(xProducts) + 1)
        c(i, 2) = UBound(xProducts) + 1
        k = 3
        For Each pd In xProducts
          c(i, k) = pd
          k = k + 1
        Next
      End If
    Next i
    sh2.Range("E1").Resize(UBound(a), 1000).Value = c
  Next j
  sh.Select
End Sub