Duplicate Line by cell qty

R

reldridge

Joined
Dec 3, 2012
Messages
2
Reaction score
0
I have a spreadsheet as layed out below: I need to duplicate any lines that the qty is above 4000, and create a new line for the remainder.

So the one with a qty of 6000 would change to two lines:
AIRPORT STATION 4000 RACK AIRPORT STATION 8
AIRPORT STATION 2000 RACK AIRPORT STATION 8

Raw data:

IN_CARE_OFQUANTITYLOCATIONCARD
AIRPORT STATION 200 RACK AIRPORT STATION 1
AIRPORT STATION 4000 RACK AIRPORT STATION 4
AIRPORT STATION 8000 RACK AIRPORT STATION 005/10
AIRPORT STATION 200 RACK AIRPORT STATION 7
AIRPORT STATION 6000 RACK AIRPORT STATION 8
AIRPORT STATION 800 RACK AIRPORT STATION 9
AIRPORT STATION 1000 RACK AIRPORT STATION 11
 
Last edited:
Can i alter this code so that the insert of colume "B" is then minused by 4000?

Code: 
Sub testme()
Dim wks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim HowManyMore As Long
Set wks = Worksheets("Sheet1")
With wks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
HowManyMore = .Cells(iRow, "G").Value - 1
If HowManyMore > 0 Then
.Rows(iRow + 1).Resize(HowManyMore).Insert
.Cells(iRow + 1, "A").Resize(HowManyMore, 1).Value _
= .Cells(iRow, "A").Value
.Cells(iRow + 1, "B").Resize(HowManyMore, 1).Value _
= .Cells(iRow, "B").Value
.Cells(iRow + 1, "C").Resize(HowManyMore, 1).Value _
= .Cells(iRow, "C").Value
.Cells(iRow + 1, "D").Resize(HowManyMore, 1).Value _
= .Cells(iRow, "D").Value
.Cells(iRow + 1, "E").Resize(HowManyMore, 1).Value _
= .Cells(iRow, "E").Value
.Cells(iRow + 1, "H").Resize(HowManyMore, 1).Value _
= .Cells(iRow, "H").Value
End If
Next iRow
End With
End Sub
 
Back
Top