Row Manipulation / duplicate dependant on cell value... and perform calculation on another cell...

I recieve a file from one customer and once i have fed it into our system i
pass it on to another company.

Problem: The other company's system only accepts rows as single units:

If you look at the example below, the problem lies with the ReturnedQty
column. Works fine for people who pass to me, works fine for me, but when
we pass it on, they are having to manually split any row with a ReturnedQty
> 1. They have to paste it however many times and divide the NettCost
column by the Qty so their system accepts it. CRAZY!
I know its not really my problem, however as they send us report which is
always incorrect i decided to send the files preformatted for them...

IDCode STCode VenNo SupCode Date CCode EANCode Description Colour Size
PartNumber NettCost ReturnedQty VATRate VAT DisposalDate Company VATRegNo
ReasonCode
RE01112003820564 FAE111 200382 200382 20060806 26743417 4114838041232
Product 1 Chrome Plated NO SIZE 1111 9.99 1 17.5 0 06/09/2006 C1 GB999999999
A
RE01132003820557 CHD113 200382 200382 20060806 27110041 4114838077536
Product 2 Aliminium NO SIZE 2222 2 1 17.5 0 06/09/2006 C2 GB999999999 A
RE01212003820678 DLN121 200382 200382 20060806 22918017 4114838033267
Product 233 Chrome Plated NO SIZE 0233 4.75 3 17.5 0 06/09/2006 C3
GB999999999 B
RE06882003820925 HUD688 200382 200382 20060806 26617268 4114838063456
Product 4 steel NO SIZE 4444 82 2 17.5 0 06/09/2006 C4 GB999999999 B
RE03262003820699 BRW326 200382 200382 20060806 27081419 4114838075423
Product 26 Chrome Plated NO SIZE 2626 58.4 4 17.5 0 06/09/2006 C5
GB999999999 C
RE02412003820933 BOL241 200382 200382 20060807 26538334 4114838069754
Product 625 brushed chrome NO SIZE 6250 30 2 17.5 0 07/09/2006 C6
GB999999999 B
RE02412003820933 BOL241 200382 200382 20060807 27089835 4114838072466
Product 23 Chrome Plated NO SIZE 2323 51.8 4 17.5 0 07/09/2006 C7
GB999999999 B


I have have been trying to figure out if i can copy the sheet to a temp
sheet with all the Qty 1, then 2, 3 ,4 etc...

Was thinking something like:
------------------------------------------------
sub loop2()

ActiveSheet.Range("A1").AutoFilter
Selection.AutoFilter Field:=13, Criteria1:="2"
Call CopyFilter

End sub
-----------------------------------------------
Sub CopyFilter()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("Sheet2").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Sheet2").Range("A1")
End If
ActiveSheet.ShowAllData

End Sub
-----------------------------------------------

Make a autofilter for each Qty within a loop then use Tom's CopyFilter to
move it over to Sheet2 or something ...
Still doesnt solve the prob of how to get the row to split and divide the
net.
This:
RE06882003820925 HUD688 200382 200382 20060806 26617268 4114838063456
Product 4 steel NO SIZE 4444 82 2 17.5 0 06/09/2006 C4 GB999999999 B

would become:

RE06882003820925 HUD688 200382 200382 20060806 26617268 4114838063456
Product 4 steel NO SIZE 4444 41 1 17.5 0 06/09/2006 C4 GB999999999 B

RE06882003820925 HUD688 200382 200382 20060806 26617268 4114838063456
Product 4 steel NO SIZE 4444 41 1 17.5 0 06/09/2006 C4 GB999999999 B


Not sure if i made much sense, but if anyone can offer suggestions including
if they think i am wasting my time filtering through by Qty etc.

Suggestions welcome.

Thanks

Brian

Column breakdown - Not very clear in first post

Column Breakdown A - S

NetCost is Column L
Returned Qty is Column M

A [RE06882003820925]
B [HUD688]
C [200382]
D [200382]
E [20060806]
F [26617268]
G [4114838063456]
H [Product 4]
I [steel]
J [NO SIZE]
K [4444]
L [82]
M [2]
N [17.5]
O [0]
P [06/09/2006]
Q [C4]
R [GB999999999]
S [B]

So column M has the returned quantity and column L has the net cost?
And every other column will contain the same value as the "real" row?

And I don't think I'd manipulate the data that way--with the filters. I think
I'd just do the "repeat" and adjust to the worksheet with the values.

If yes, then this little macro seems to work ok:

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long

Dim NetCostCol As Long
Dim RetQtyCol As Long
Dim TotalNumberOfRows As Long

Set wks = ActiveSheet

With wks
NetCostCol = .Range("L1").Column
RetQtyCol = .Range("M1").Column
FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, RetQtyCol).End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
TotalNumberOfRows = .Cells(iRow, RetQtyCol).Value
If TotalNumberOfRows > 1 Then
.Rows(iRow + 1).Resize(TotalNumberOfRows - 1).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(TotalNumberOfRows - 1)
.Cells(iRow, RetQtyCol).Resize(TotalNumberOfRows).Value = 1
.Cells(iRow, NetCostCol).Resize(TotalNumberOfRows).Value _
= .Cells(iRow, NetCostCol).Value / TotalNumberOfRows
End If
Next iRow
End With

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

This macro does destroy the original data--run it against a copy of your sheet
or save without closing if you find an error.

Brian wrote:
>
> I recieve a file from one customer and once i have fed it into our system i
> pass it on to another company.
>
> Problem: The other company's system only accepts rows as single units:
>
> If you look at the example below, the problem lies with the ReturnedQty
> column. Works fine for people who pass to me, works fine for me, but when
> we pass it on, they are having to manually split any row with a ReturnedQty
> > 1. They have to paste it however many times and divide the NettCost
> column by the Qty so their system accepts it. CRAZY!
> I know its not really my problem, however as they send us report which is
> always incorrect i decided to send the files preformatted for them...
>
> IDCode STCode VenNo SupCode Date CCode EANCode Description Colour Size
> PartNumber NettCost ReturnedQty VATRate VAT DisposalDate Company VATRegNo
> ReasonCode
> RE01112003820564 FAE111 200382 200382 20060806 26743417 4114838041232
> Product 1 Chrome Plated NO SIZE 1111 9.99 1 17.5 0 06/09/2006 C1 GB999999999
> A
> RE01132003820557 CHD113 200382 200382 20060806 27110041 4114838077536
> Product 2 Aliminium NO SIZE 2222 2 1 17.5 0 06/09/2006 C2 GB999999999 A
> RE01212003820678 DLN121 200382 200382 20060806 22918017 4114838033267
> Product 233 Chrome Plated NO SIZE 0233 4.75 3 17.5 0 06/09/2006 C3
> GB999999999 B
> RE06882003820925 HUD688 200382 200382 20060806 26617268 4114838063456
> Product 4 steel NO SIZE 4444 82 2 17.5 0 06/09/2006 C4 GB999999999 B
> RE03262003820699 BRW326 200382 200382 20060806 27081419 4114838075423
> Product 26 Chrome Plated NO SIZE 2626 58.4 4 17.5 0 06/09/2006 C5
> GB999999999 C
> RE02412003820933 BOL241 200382 200382 20060807 26538334 4114838069754
> Product 625 brushed chrome NO SIZE 6250 30 2 17.5 0 07/09/2006 C6
> GB999999999 B
> RE02412003820933 BOL241 200382 200382 20060807 27089835 4114838072466
> Product 23 Chrome Plated NO SIZE 2323 51.8 4 17.5 0 07/09/2006 C7
> GB999999999 B
>
> I have have been trying to figure out if i can copy the sheet to a temp
> sheet with all the Qty 1, then 2, 3 ,4 etc...
>
> Was thinking something like:
> ------------------------------------------------
> sub loop2()
>
> ActiveSheet.Range("A1").AutoFilter
> Selection.AutoFilter Field:=13, Criteria1:="2"
> Call CopyFilter
>
> End sub
> -----------------------------------------------
> Sub CopyFilter()
> 'by Tom Ogilvy
> Dim rng As Range
> Dim rng2 As Range
>
> With ActiveSheet.AutoFilter.Range
> On Error Resume Next
> Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
> .SpecialCells(xlCellTypeVisible)
> On Error GoTo 0
> End With
> If rng2 Is Nothing Then
> MsgBox "No data to copy"
> Else
> Worksheets("Sheet2").Cells.Clear
> Set rng = ActiveSheet.AutoFilter.Range
> rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
> Destination:=Worksheets("Sheet2").Range("A1")
> End If
> ActiveSheet.ShowAllData
>
> End Sub
> -----------------------------------------------
>
> Make a autofilter for each Qty within a loop then use Tom's CopyFilter to
> move it over to Sheet2 or something ...
> Still doesnt solve the prob of how to get the row to split and divide the
> net.
> This:
> RE06882003820925 HUD688 200382 200382 20060806 26617268 4114838063456
> Product 4 steel NO SIZE 4444 82 2 17.5 0 06/09/2006 C4 GB999999999 B
>
> would become:
>
> RE06882003820925 HUD688 200382 200382 20060806 26617268 4114838063456
> Product 4 steel NO SIZE 4444 41 1 17.5 0 06/09/2006 C4 GB999999999 B
>
> RE06882003820925 HUD688 200382 200382 20060806 26617268 4114838063456
> Product 4 steel NO SIZE 4444 41 1 17.5 0 06/09/2006 C4 GB999999999 B
>
> Not sure if i made much sense, but if anyone can offer suggestions including
> if they think i am wasting my time filtering through by Qty etc.
>
> Suggestions welcome.
>
> Thanks
>
> Brian

--

Dave Peterson

That worked perfect!!!

much appreciated.

Brian


"Dave Peterson" <petersod@verizonXSPAM.net> wrote in message
news:44E0AD24.CB467F41@verizonXSPAM.net...
> So column M has the returned quantity and column L has the net cost?
> And every other column will contain the same value as the "real" row?
>
> And I don't think I'd manipulate the data that way--with the filters. I
> think
> I'd just do the "repeat" and adjust to the worksheet with the values.
>
> If yes, then this little macro seems to work ok:
>
> Option Explicit
> Sub testme()
>
> Dim wks As Worksheet
> Dim FirstRow As Long
> Dim LastRow As Long
> Dim iRow As Long
>
> Dim NetCostCol As Long
> Dim RetQtyCol As Long
> Dim TotalNumberOfRows As Long
>
> Set wks = ActiveSheet
>
> With wks
> NetCostCol = .Range("L1").Column
> RetQtyCol = .Range("M1").Column
> FirstRow = 2 'headers in row 1
> LastRow = .Cells(.Rows.Count, RetQtyCol).End(xlUp).Row
>
> For iRow = LastRow To FirstRow Step -1
> TotalNumberOfRows = .Cells(iRow, RetQtyCol).Value
> If TotalNumberOfRows > 1 Then
> .Rows(iRow + 1).Resize(TotalNumberOfRows - 1).Insert
> .Rows(iRow).Copy _
> Destination:=.Rows(iRow + 1).Resize(TotalNumberOfRows -
> 1)
> .Cells(iRow, RetQtyCol).Resize(TotalNumberOfRows).Value = 1
> .Cells(iRow, NetCostCol).Resize(TotalNumberOfRows).Value _
> = .Cells(iRow, NetCostCol).Value / TotalNumberOfRows
> End If
> Next iRow
> End With
>
> End Sub
>
> If you're new to macros, you may want to read David McRitchie's intro at:
> http://www.mvps.org/dmcritchie/excel/getstarted.htm
>
> This macro does destroy the original data--run it against a copy of your
> sheet
> or save without closing if you find an error.
>
> Brian wrote:
>>
>> I recieve a file from one customer and once i have fed it into our system
>> i
>> pass it on to another company.
>>
>> Problem: The other company's system only accepts rows as single units:
>>
>> If you look at the example below, the problem lies with the ReturnedQty
>> column. Works fine for people who pass to me, works fine for me, but
>> when
>> we pass it on, they are having to manually split any row with a
>> ReturnedQty
>> > 1. They have to paste it however many times and divide the NettCost
>> column by the Qty so their system accepts it. CRAZY!
>> I know its not really my problem, however as they send us report which is
>> always incorrect i decided to send the files preformatted for them...
>>
>> IDCode STCode VenNo SupCode Date CCode EANCode Description Colour
>> Size
>> PartNumber NettCost ReturnedQty VATRate VAT DisposalDate Company VATRegNo
>> ReasonCode
>> RE01112003820564 FAE111 200382 200382 20060806 26743417
>> 4114838041232
>> Product 1 Chrome Plated NO SIZE 1111 9.99 1 17.5 0 06/09/2006 C1
>> GB999999999
>> A
>> RE01132003820557 CHD113 200382 200382 20060806 27110041
>> 4114838077536
>> Product 2 Aliminium NO SIZE 2222 2 1 17.5 0 06/09/2006 C2 GB999999999 A
>> RE01212003820678 DLN121 200382 200382 20060806 22918017
>> 4114838033267
>> Product 233 Chrome Plated NO SIZE 0233 4.75 3 17.5 0 06/09/2006 C3
>> GB999999999 B
>> RE06882003820925 HUD688 200382 200382 20060806 26617268
>> 4114838063456
>> Product 4 steel NO SIZE 4444 82 2 17.5 0 06/09/2006 C4 GB999999999 B
>> RE03262003820699 BRW326 200382 200382 20060806 27081419
>> 4114838075423
>> Product 26 Chrome Plated NO SIZE 2626 58.4 4 17.5 0 06/09/2006 C5
>> GB999999999 C
>> RE02412003820933 BOL241 200382 200382 20060807 26538334
>> 4114838069754
>> Product 625 brushed chrome NO SIZE 6250 30 2 17.5 0 07/09/2006 C6
>> GB999999999 B
>> RE02412003820933 BOL241 200382 200382 20060807 27089835
>> 4114838072466
>> Product 23 Chrome Plated NO SIZE 2323 51.8 4 17.5 0 07/09/2006 C7
>> GB999999999 B
>>
>> I have have been trying to figure out if i can copy the sheet to a temp
>> sheet with all the Qty 1, then 2, 3 ,4 etc...
>>
>> Was thinking something like:
>> ------------------------------------------------
>> sub loop2()
>>
>> ActiveSheet.Range("A1").AutoFilter
>> Selection.AutoFilter Field:=13, Criteria1:="2"
>> Call CopyFilter
>>
>> End sub
>> -----------------------------------------------
>> Sub CopyFilter()
>> 'by Tom Ogilvy
>> Dim rng As Range
>> Dim rng2 As Range
>>
>> With ActiveSheet.AutoFilter.Range
>> On Error Resume Next
>> Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
>> .SpecialCells(xlCellTypeVisible)
>> On Error GoTo 0
>> End With
>> If rng2 Is Nothing Then
>> MsgBox "No data to copy"
>> Else
>> Worksheets("Sheet2").Cells.Clear
>> Set rng = ActiveSheet.AutoFilter.Range
>> rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
>> Destination:=Worksheets("Sheet2").Range("A1")
>> End If
>> ActiveSheet.ShowAllData
>>
>> End Sub
>> -----------------------------------------------
>>
>> Make a autofilter for each Qty within a loop then use Tom's CopyFilter to
>> move it over to Sheet2 or something ...
>> Still doesnt solve the prob of how to get the row to split and divide the
>> net.
>> This:
>> RE06882003820925 HUD688 200382 200382 20060806 26617268
>> 4114838063456
>> Product 4 steel NO SIZE 4444 82 2 17.5 0 06/09/2006 C4 GB999999999 B
>>
>> would become:
>>
>> RE06882003820925 HUD688 200382 200382 20060806 26617268
>> 4114838063456
>> Product 4 steel NO SIZE 4444 41 1 17.5 0 06/09/2006 C4 GB999999999 B
>>
>> RE06882003820925 HUD688 200382 200382 20060806 26617268
>> 4114838063456
>> Product 4 steel NO SIZE 4444 41 1 17.5 0 06/09/2006 C4 GB999999999 B
>>
>> Not sure if i made much sense, but if anyone can offer suggestions
>> including
>> if they think i am wasting my time filtering through by Qty etc.
>>
>> Suggestions welcome.
>>
>> Thanks
>>
>> Brian
>
> --
>
> Dave Peterson