Searching for data and inserting new rows

[Guest]

Hi
I have a spreadsheet from one of our clothing suppliers, which I am going to
import into our database for ordering. The format is:
Part No. / Description / Price / Size
The size is given as a range (i.e M-XL) for each item of clothing

What I want to do is analyse the size range and extract what sizes are
available, then insert new rows for each of these sizes
So, M-XL becomes:
Part No/ Description / Price / M
Part No / Description / Price / L
Part No / Description / Price / XL

I've got over 800 individual lines to do, so any help on automating this
task would be helpful!!

Thanks in advance

 

[Dave Peterson]

So each row becomes 4 (the existing and 3 more).

(I'm guessing that the existing row would already show S (small). Then you want
to add M,L,XL.)

If that's close:

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim myNewSizes As Variant
Dim TotalNewSizes As Long
Dim ColsToCopy As Long

Set wks = Worksheets("sheet1")

myNewSizes = Array("M", "L", "XL")
TotalNewSizes = UBound(myNewSizes) - LBound(myNewSizes) + 1

ColsToCopy = 3 'A:C

With wks
FirstRow = 2 'headers in row 1???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(TotalNewSizes).EntireRow.Insert
.Cells(iRow + 1, "A").Resize(TotalNewSizes, ColsToCopy).Value _
= .Cells(iRow, "A").Resize(1, ColsToCopy).Value
.Cells(iRow + 1, ColsToCopy + 1).Resize(TotalNewSizes, 1).Value _
= Application.Transpose(myNewSizes)
Next iRow
End With

End Sub

 

[Guest]

Thanks for your help, Dave. Greatly appreciated

So each row becomes 4 (the existing and 3 more).

(I'm guessing that the existing row would already show S (small). Then you want
to add M,L,XL.)

If that's close:

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim myNewSizes As Variant
Dim TotalNewSizes As Long
Dim ColsToCopy As Long

Set wks = Worksheets("sheet1")

myNewSizes = Array("M", "L", "XL")
TotalNewSizes = UBound(myNewSizes) - LBound(myNewSizes) + 1

ColsToCopy = 3 'A:C

With wks
FirstRow = 2 'headers in row 1???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(TotalNewSizes).EntireRow.Insert
.Cells(iRow + 1, "A").Resize(TotalNewSizes, ColsToCopy).Value _
= .Cells(iRow, "A").Resize(1, ColsToCopy).Value
.Cells(iRow + 1, ColsToCopy + 1).Resize(TotalNewSizes, 1).Value _
= Application.Transpose(myNewSizes)
Next iRow
End With

End Sub