Resize data to new sheet, copying data N times based count total from specific columns containing data

Hi

I have a list of data in table format which is copied to 2 different tabs.

Labels Tab - replicates the data N times based on the Value in each column H:M, then based on the size details in column F, fills in the size on each row. - This Macro works perfectly well.

Export Tab - counts the number of cells containing data in each row, and replicates N times based on the Count. (if there are 3 sizes with orders, copy the row 3 times and show which sizes are ordered) This replication is working but I cannot figure out how to get the size to show only once and not for the count. The code is using .value which is causing the issue but I cannot figure out. after several hours of trying, what to change it to

I hope this makes sense.

Many thanks in advance.

J

Option Explicit
Sub Export()       '----Create a list of products for export - require 1 row for each size orderd
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long, j As Long, n As Integer

Set ws1 = Worksheets("Data")
Set ws2 = Worksheets("Export")

 Application.ScreenUpdating = False
 
 '-----Clear Existing Results
 With ws2.Cells(1, 1)
 .CurrentRegion.ClearContents
 End With
 
 '-----Replicate Rows based on Counts
On Error Resume Next

For i = 3 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
 
    n = WorksheetFunction.CountIf(ws1.Range("H" & i & ": M" & i), ">0")  'Count the number of cells with data in cols H-M
    ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Offset(1).Resize(n, 4).Value = ws1.Cells(i, 2).Resize(, 4).Value  ' Insert "n" rows & get data Cols B-E
    ws2.Cells(ws2.Rows.Count, 5).End(xlUp).Offset(1).Resize(n, 1).Value = ws1.Cells(i, 7).Resize(, 1).Value  ' Get the RRP
    
    '-----???This section is not giving the desired result
    '-----Get the sizes
    For j = 8 To 13
        If (IsNumeric(Left(ws1.Cells(i, 6).Value, 1))) = True Then
                    ws2.Cells(ws2.Rows.Count, 6).End(xlUp).Offset(1).Resize(ws1.Cells(i, j).Value, 1).Value = ws1.Cells(2, j).Resize(1, j).Value
              Else
                    ws2.Cells(ws2.Rows.Count, 6).End(xlUp).Offset(1).Resize(ws1.Cells(i, j).Value, 1).Value = ws1.Cells(1, j).Resize(1, j).Value
        End If
    Next j
Next i

Application.CutCopyMode = False
End Sub

Hi Carim,

Thanks for the above. I think line 28 does check for numeric/alpha and it produce the correct result in the label macro, but I'm stuck with the size replicating per the count instead of just once per line in the Export macro. Please let me know if I am not explaining clearly.

If (IsNumeric(Left(ws1.Cells(i, 6).Value, 1))) = True Then

Cheers

J

Hi Carim,

Thank you for the file ..works perfectly. I figured it probably needed to do a check of the cell, but converting the mental logic to VBA is sometimes difficult especially when one is a beginner. I enjoy the challenge and am very grateful for the help and your dedication to helping others.

Cheers and have a great day.

J

Hi Carim

Google is a great teacher, many hours of research, trial and error and of course the icing on cake is the help from OZGrid.