inserting correct number of rows

[tina]

Hi
I need some advice of best way to do following
I have a sheet with a number of orders where each order can have between 1
and 10 codes . I need each order to have 10 codes (rows) with blank rows ( in
sequence)where no order for specific code
example
order code qty
100000 a1 2
100000 a3 5
100000 a6 5
200000 a2 4
200000 a3 4

need to look like
order code qty
100000 a1 2
100000 a2
100000 a3 5
100000 a4
100000 a5
100000 a6 5
100000 a7
100000 a8
100000 a9
100000 a10
200000 a1
200000 a2 4
200000 a3 4
200000 a4
etc
I have tried for counter anf if statements but getting very complicated and
think there must be better way any tips would be great
Thank you
Tina

 

[Jacob Skaria]

Suppose you have your data in Sheet1.

--In Sheet2 create a list of order numbers and codes as below. If you dont
have a list of orders; generate a list in ColA using Data>Filter>Advanced
Filter>'Unique records'. ColB will have the 10 codes.

order code
100000 a1
200000 a2
300001 a3
300002 a4
300003 a5
300004 a6
300005 a7
300006 a8
300007 a9
300008 a10
300009
300010
300011
300012
300013

--Run the below macro which will generate a list as you mentioned in Col C
and D

Sub Reproduce()
Dim rng1 As Range, rng2 As Range, lngRow As Long

lngRow = 2
Set rng1 = Range("A2:A16")
Set rng2 = Range("B2:B11")

For Each cell In rng1
Range("C" & lngRow).Resize(rng2.Rows.Count).Value = cell.Text
Range("D" & lngRow).Resize(rng2.Rows.Count).Value = rng2.Value
lngRow = lngRow + rng2.Rows.Count
Next
End Sub

--Now in column E cell E2 use the below formula which will bring the
relevant values. Copy the formula down as required.

=SUMPRODUCT((Sheet1!$A$1:$A$1000=C2)*(Sheet1!$B$1:$B$1000=D2),(Sheet1!$C$1:$C$1000))



If this post helps click Yes

 

[Bob Phillips]

Why do the numbers signify exactly? Do you sum them max 10 and use that?

 

[Joel]

The code below is self explanitory. The easist way is to create a new sheet
with all the order numbers and codes. Then go through a 2nd loop putting in
the quantities. the new sheet has all the codes so there are more rows in
the new sheet than the old sheet. Because I sorted both sheets I can simply
compares the codes and order from both sheets and fill in the quanties when
they match.


Sub MakeOrders()

codes = Array("a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9", "a10")

Set Oldsht = Sheets("Sheet1")
Set Newsht = Sheets.Add(after:=Sheets(Sheets.Count))

'create sheet with oders and codes without quantities
With Oldsht
'copy header row
.Rows(1).Copy Destination:=Newsht.Rows(1)
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'sort original sheet
.Rows("1:" & LastRow).Sort _
header:=xlYes, _
key1:=.Range("A1"), _
order1:=xlAscending, _
key2:=.Range("B1"), _
order2:=xlAscending

OldOrder = ""
NewRowCount = 2
For OldRowCount = 2 To LastRow
Order = .Range("A" & OldRowCount)
If OldOrder <> Order Then
'add the order number and 10 codes to new sheet
For Each itm In codes
With Newsht
.Range("A" & NewRowCount) = Order
.Range("B" & NewRowCount) = itm
NewRowCount = NewRowCount + 1
End With
Next itm
OldOrder = Order
End If
Next OldRowCount

End With

With Newsht

'now sort new sheet to get order numbers in same order and old sheet
NewLastRow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("1:" & NewLastRow).Sort _
header:=xlYes, _
key1:=.Range("A1"), _
order1:=xlAscending, _
key2:=.Range("B1"), _
order2:=xlAscending

'now put quantities in new sheet
OldRowCount = 2
For NewRowCount = 2 To NewLastRow
NewOrder = .Range("A" & NewRowCount)
NewCode = .Range("B" & NewRowCount)
OldOrder = Oldsht.Range("A" & OldRowCount)
OldCode = Oldsht.Range("B" & OldRowCount)
If OldOrder = NewOrder And _
OldCode = NewCode Then

Qty = Oldsht.Range("c" & OldRowCount)
.Range("C" & NewRowCount) = Qty
OldRowCount = OldRowCount + 1
End If
Next NewRowCount
End With

End Sub

 

[Jacob Skaria]

The same can be done using code. Try the below which will insert a new sheet
next to the active sheet and generate what you want. Try and feedback.


Sub Expand()

Dim rng1 As Range, rng2 As Variant, lngRow As Long
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveSheet
Set ws2 = Worksheets.Add(after:=ActiveSheet)
ws1.Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ws2.Range("A1"), Unique:=True
lngRow = 2
Set rng1 = ws2.Range("A2:A" & ws2.Cells(Rows.Count, "A").End(xlUp).Row)
rng2 = Array("a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9", "a10")

For Each cell In rng1
ws2.Range("B" & lngRow).Resize(10).Value = cell.Text
ws2.Range("C" & lngRow).Resize(10).Value = WorksheetFunction.Transpose(rng2)
lngRow = lngRow + 10
Next

ws2.Range("D2" & ws2.Cells(Rows.Count, "C").End(xlUp).Row) = _
"=SUMPRODUCT((Sheet1!$A$1:$A$1000=B2)*(Sheet1!$B$1:$B$1000=C2)," & _
"(Sheet1!$C$1:$C$1000))"
ws2.Range("B11").Value = ws1.Range("A1:C1").Value: ws2.Columns(1).Delete

End Sub


If this post helps click Yes