PDA

View Full Version : Solved: Copy Criteria vba



Shazam
08-15-2006, 01:31 PM
Hi everyone,


I would like to have a code that will copy between the heading named ?Customer? and the bottom named ?Grand?, BUT ignore blanks and totals. It should copy the information in columns D and E and paste it into worksheet tab ?Results?


I left a very small example workbook below. Look in the Results worksheet it should come out like that. My data fluctuates daily.

makako
08-15-2006, 01:53 PM
If the column C is always empty on the rows u want to copy this may work

Sub Copy()
Dim lvRange As Range
Set lvRange = Range("C3").CurrentRegion
With lvRange
.AutoFilter Field:=1, Criteria1:="="
.CurrentRegion.Resize(lvRange.Rows.Count - 1, _
lvRange.Columns.Count - 1).Offset(1, 1).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Results").Range("A1").End(xlDown).Offset(1)
.CurrentRegion.AutoFilter
End With
End Sub

Shazam
08-15-2006, 01:59 PM
Thanks for replying makako,



I tried your code and its giving me a run time error '1004'. Also it's highlighting this line.


.AutoFilter Field:=1, Criteria1:="="
.CurrentRegion.Resize(lvRange.Rows.Count - 1, _
lvRange.Columns.Count - 1).Offset(1, 1).SpecialCells(xlCellTypeVisible).Copy _
Sheets("Results").Range("A1").End(xlDown).Offset(1)



What do you think?

mdmackillop
08-15-2006, 02:06 PM
Sub Extracts()
Range("C3:" & [E65536].End(xlUp).Address).AutoFilter Field:=1, Criteria1:="="
Range("D3:" & [E65536].End(xlUp).Address).Copy Sheets("Results").[a1]
Sheets("Results").Range("A1:B1").Orientation = 0
Selection.AutoFilter
End Sub

Shazam
08-15-2006, 02:09 PM
Sub Extracts()
Range("C3:" & [E65536].End(xlUp).Address).AutoFilter Field:=1, Criteria1:="="
Range("D3:" & [E65536].End(xlUp).Address).Copy Sheets("Results").[a1]
Sheets("Results").Range("A1:B1").Orientation = 0
Selection.AutoFilter
End Sub



Excellent just excellent. I will test your code couple more times before I make this thread solve.


Thank You very much!

mdmackillop

Bob Phillips
08-15-2006, 02:21 PM
Should work.

Try this small varietal



Sub Copy()
Dim lvRange As Range
Dim rng As Range
Set lvRange = Worksheets("Sheet1").Range("C3").CurrentRegion
With lvRange
.AutoFilter Field:=1, Criteria1:="="
Set rng = .CurrentRegion.Resize(lvRange.Rows.Count - 1, _
lvRange.Columns.Count - 1).Offset(0, 1).SpecialCells(xlCellTypeVisible)
rng.Copy Sheets("Results").Range("A1")
.AutoFilter
End With
End Sub

Zack Barresse
08-15-2006, 02:25 PM
Why not just ...

Sub Extracts()
With Sheets("Sheet1")
.Range("C3", .Cells(.Rows.Count, "E").End(xlUp)).AutoFilter Field:=1, Criteria1:="="
.Range("D3", .Cells(.Rows.Count, "E").End(xlUp)).Copy Sheets("Results").Range("A1")
Sheets("Results").Range("A1:B1").Orientation = 0
.AutoFilterMode = False
End With
End Sub

mdmackillop
08-15-2006, 02:36 PM
Why not just ...
I like a bit of variety! :whistle:

Shazam
08-16-2006, 05:59 AM
Thank You for the replys. The codes work of the example workbook I posted. But not the actual workbook I'm using. I should've notice it in the first place my fault.

Here is the the actual workbook I'm using. Can the code be modified to copy between the header ?Customer? and the bottom named ?Grand?, BUT ignore blanks and totals?


I attach the workbook below.

mdmackillop
08-16-2006, 09:53 AM
Sub Extracts()
Dim rGrand As Range, rCustomer As Range
With Sheets("Sheet1")
Set rCustomer = .Columns(3).Find("Customer")
Set rGrand = .Columns(3).Find("Grand")
.Range(rCustomer, rGrand.Offset(, 2)).AutoFilter Field:=1, Criteria1:="="
.Range(rCustomer.Offset(, 1), rGrand.Offset(, 2)).Copy Sheets("Results").[a1]
.Range(rCustomer, rGrand.Offset(, 2)).AutoFilter
End With
Sheets("Results").Range("A1:B1").Orientation = 0
End Sub

Shazam
08-16-2006, 12:24 PM
Thank you so much mdmackillop it works great!:hi: