Copying rows from worksheet A to worksheet B based on criteria

[Guest]

Not too familiar with programming language and hoping someone can help me...

I am attempting to copy rows from one worksheet to another based on specific
criteria. My spreadsheet looks like this (hope this format is clear):

Company Selling Volume Price Company Buying
A 20,000 $80.00 B
C 45,000 $81.75 F
B 20,000 $82.50 G
L 15,000 $81.25 P

Here's what I'd like to do:

If a company bought and sold the same volume, I want to copy those two rows
to another worksheet. For instance, in this example Company B bought 20,000
at $80.00 and subsequently sold 20,000 at $82.50. Any assistance would be
greatly appreciated.

Thanks,
J

 

[matt]

Not too familiar with programming language and hoping someone can help me...

I am attempting to copy rows from one worksheet to another based on specific
criteria. My spreadsheet looks like this (hope this format is clear):

Company Selling Volume Price Company Buying
A 20,000 $80.00 B
C 45,000 $81.75 F
B 20,000 $82.50 G
L 15,000 $81.25 P

Here's what I'd like to do:

If a company bought and sold the same volume, I want to copy those two rows
to another worksheet. For instance, in this example Company B bought 20,000
at $80.00 and subsequently sold 20,000 at $82.50. Any assistance would be
greatly appreciated.

Thanks,
J

J,

I'm not sure how many entries you have, but you could simply set up an
auto filter in Excel (Data/Filter/Auto Filter). You can alter your
data set slightly with CONCATENATE (or simply the "&") to smash the
volume and company letter together to get a "more" unique identifier
(i.e. create a sellVol and buyVol column that has 20,000A in sellVol
and 20,000B in buyVol; apply this to each entry) and then filter or
sort according to the identifier. I would start with Excel before
writing a macro.

Matt

 

[merjet]

Sub CopySome()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim iR2 As Integer
Dim c As Range
Dim c1 As Range
Dim rng As Range
Dim rng1 As Range

Set ws = Sheets("Sheet1")
iEnd = ws.Range("A1").End(xlDown).Row
Set rng = ws.Range("A2:A" & iEnd)
Set rng1 = ws.Range("D2" & iEnd)
Set ws2 = Sheets("Sheet2")
ws2.UsedRange.Clear
ws.Range("A11").Copy ws2.Range("A1")
iR2 = 1
For Each c1 In rng1
For Each c In rng
If c = c1 And c.Offset(0, 1) = c1.Offset(0, -2) Then
iR2 = iR2 + 1
ws.Range("A" & c1.Row & "" & c1.Row).Copy ws2.Range("A"
& iR2)
iR2 = iR2 + 1
ws.Range("A" & c.Row & "" & c.Row).Copy ws2.Range("A" &
iR2)
End If
Next c
Next c1
End Sub

Hth,
Merjet