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
Kev427 wrote:
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
|