select records using VBA

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Please help!

I have a sheet(A) from colum A to colum D with field
name like this:
plan user date total

There are about 500 records in this sheet(A). now I want
to select records with date btw 04/01/04 to 04/03/04 and
user name are:
user01, user05, user03, usero4.
Is there anyway that I can program a VBA code to
aumotically select those records and copy-paste them to
sheet B?
Your help is greatly appreciated !!!!!

Meme
 
Hi Meme,

Here is a macro

Sub CopyData()
Dim iLastRow As Long
With Worksheets("A")
iLastRow = .Cells(Rows.Count, "C").End(xlUp).Row
.Columns("E:E").EntireColumn.Insert
.Range("E2").FormulaR1C1 = "=AND(OR(RC[-3]=""user01""," & _
"RC[-3]=""user03""," & _
"RC[-3]=""user04""," & _
"RC[-3]=""user05"")," & _
"AND(RC[-2]>=DATE(2004,4,1)," & _
"RC[-2]<=DATE(2004,4,3)))"
.Range("E2").AutoFill Destination:=.Range("E2:E" & iLastRow),
Type:=xlFillDefault
.Columns("E:E").AutoFilter Field:=1, Criteria1:="<>FALSE"
.Cells.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("B").Range("A1")
.Columns("E:E").EntireColumn.Delete
End With
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Hi Bob,
Thank you so much for the macro you gave to me. but some
how this following code has a syntax error when I ran the
macro. Please help me check this code:

.Range("E2").AutoFill Destination:=.Range("E2:E"
& iLastRow),Type:=xlFillDefault

Thank you in advance !
Meme
-----Original Message-----
Hi Meme,

Here is a macro

Sub CopyData()
Dim iLastRow As Long
With Worksheets("A")
iLastRow = .Cells(Rows.Count, "C").End(xlUp).Row
.Columns("E:E").EntireColumn.Insert
.Range("E2").FormulaR1C1 = "=AND(OR(RC[-3] =""user01""," & _
"RC[-3] =""user03""," & _
"RC[-3] =""user04""," & _
"RC[-3] =""user05"")," & _
"AND(RC[-2]>=DATE (2004,4,1)," & _
"RC[-2]<=DATE (2004,4,3)))"
.Range("E2").AutoFill Destination:=.Range("E2:E" & iLastRow),
Type:=xlFillDefault
.Columns("E:E").AutoFilter Field:=1,
Click to expand...
 
Meme,
Those 2 lines should be a single line, The NG wrapped around. Try this
slightly amended version

Sub CopyData()
Dim iLastRow As Long
With Worksheets("A")
iLastRow = .Cells(Rows.Count, "C").End(xlUp).Row
.Columns("E:E").EntireColumn.Insert
.Range("E2").FormulaR1C1 = "=AND(OR(RC[-3]=""user01""," & _
"RC[-3]=""user03""," & _
"RC[-3]=""user04""," & _
"RC[-3]=""user05"")," & _
"AND(RC[-2]>=DATE(2004,4,1)," & _
"RC[-2]<=DATE(2004,4,3)))"
.Range("E2").AutoFill Destination:=.Range("E2:E" & iLastRow), _
Type:=xlFillDefault
.Columns("E:E").AutoFilter Field:=1, Criteria1:="<>FALSE"
.Cells.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("B").Range("A1")
.Columns("E:E").EntireColumn.Delete
End With
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Meme said:
Hi Bob,
Thank you so much for the macro you gave to me. but some
how this following code has a syntax error when I ran the
macro. Please help me check this code:

.Range("E2").AutoFill Destination:=.Range("E2:E"
& iLastRow),Type:=xlFillDefault

Thank you in advance !
Meme
-----Original Message-----
Hi Meme,

Here is a macro

Sub CopyData()
Dim iLastRow As Long
With Worksheets("A")
iLastRow = .Cells(Rows.Count, "C").End(xlUp).Row
.Columns("E:E").EntireColumn.Insert
.Range("E2").FormulaR1C1 = "=AND(OR(RC[-3] =""user01""," & _
"RC[-3] =""user03""," & _
"RC[-3] =""user04""," & _
"RC[-3] =""user05"")," & _
"AND(RC[-2]>=DATE (2004,4,1)," & _
"RC[-2]<=DATE (2004,4,3)))"
.Range("E2").AutoFill Destination:=.Range("E2:E" & iLastRow),
Type:=xlFillDefault
.Columns("E:E").AutoFilter Field:=1,
Click to expand...
Criteria1:= said:
.Cells.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("B").Range("A1")
.Columns("E:E").EntireColumn.Delete
End With
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)




.
Click to expand...
Click to expand...
 
Hi Bob,

Your code works perfect !
I am working on transfering lotus.123 macro to Excel
macros right now,and I am a novice in using VBA.Your
code is very useful and I am sure I will use it a lot.
Again thanks for your help.

Meme
-----Original Message-----
Meme,
Those 2 lines should be a single line, The NG wrapped around. Try this
slightly amended version

Sub CopyData()
Dim iLastRow As Long
With Worksheets("A")
iLastRow = .Cells(Rows.Count, "C").End(xlUp).Row
.Columns("E:E").EntireColumn.Insert
.Range("E2").FormulaR1C1 = "=AND(OR(RC[-3] =""user01""," & _
"RC[-3] =""user03""," & _
"RC[-3] =""user04""," & _
"RC[-3] =""user05"")," & _
"AND(RC[-2]>=DATE (2004,4,1)," & _
"RC[-2]<=DATE (2004,4,3)))"
.Range("E2").AutoFill Destination:=.Range("E2:E" & iLastRow), _
Type:=xlFillDefault
.Columns("E:E").AutoFilter Field:=1,
Click to expand...
Criteria1:= said:
.Cells.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("B").Range("A1")
.Columns("E:E").EntireColumn.Delete
End With
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Hi Bob,
Thank you so much for the macro you gave to me. but some
how this following code has a syntax error when I ran the
macro. Please help me check this code:

.Range("E2").AutoFill Destination:=.Range ("E2:E"
& iLastRow),Type:=xlFillDefault

Thank you in advance !
Meme
-----Original Message-----
Hi Meme,

Here is a macro

Sub CopyData()
Dim iLastRow As Long
With Worksheets("A")
iLastRow = .Cells(Rows.Count, "C").End (xlUp).Row
.Columns("E:E").EntireColumn.Insert
.Range("E2").FormulaR1C1 = "=AND(OR(RC[-3] =""user01""," & _
"RC[-3] =""user03""," & _
"RC[-3] =""user04""," & _
"RC[-3] =""user05"")," & _
"AND(RC[-2]
Click to expand...
=DATE
(2004,4,1)," & _
"RC[-2]
Click to expand...
<=DATE
(2004,4,3)))"
.Range("E2").AutoFill Destination:=.Range
Click to expand...
("E2:E"
& iLastRow),
Type:=xlFillDefault
.Columns("E:E").AutoFilter Field:=1,
Click to expand...
Criteria1:= said:
.Cells.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("B").Range("A1")
.Columns("E:E").EntireColumn.Delete
End With
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Please help!

I have a sheet(A) from colum A to colum D with field
name like this:
plan user date total

There are about 500 records in this sheet(A). now I want
to select records with date btw 04/01/04 to 04/03/04 and
user name are:
user01, user05, user03, usero4.
Is there anyway that I can program a VBA code to
aumotically select those records and copy-paste them to
sheet B?
Your help is greatly appreciated !!!!!

Meme


.
Click to expand...
Click to expand...


.
Click to expand...
 
Hi,

Try this

Sub ExtractData()
Dim Rng As Range
Dim lRows As Long
Dim iCols As Integer

'Assuming a data download block beginning in A1 of active sheet
Set Rng = Range("A1").CurrentRegion

'Get rows and column numbers
With Rng
lRows = .Rows.Count
iCols = .Columns.Count
'add new col headers
.Cells(1, iCols + 1).FormulaR1C1 = "user_ok"
.Cells(1, iCols + 2).FormulaR1C1 = "date_ok"
'Insert formulas in other cells
.Range(Cells(2, iCols + 1), Cells(lRows, iCols + 1)).FormulaR1C1 = _

"=OR((RC[-3]=""user01""),(RC[-3]=""user03""),(RC[-3]=""user04""),(RC[-3]=""u
ser05""))"
.Range(Cells(2, iCols + 2), Cells(lRows, iCols + 2)).FormulaR1C1 = _
"=OR((RC[-3]=DATE(2004,4,1)),(RC[-3]=DATE(2004,4,4)))"
End With

'Reset rng
Set Rng = Range("A1").CurrentRegion
iCols = Rng.Columns.Count

'filter list and copy visible rows
With Rng
.AutoFilter Field:=iCols - 1, Criteria1:="TRUE"
.AutoFilter Field:=iCols, Criteria1:="TRUE"
.Cells.SpecialCells(xlCellTypeVisible).Copy 'Copy visible rows
End With
Sheets.Add Count:=1
ActiveSheet.Paste
Application.CutCopyMode = False

With Range("A1")
.Select
.CurrentRegion.Columns.AutoFit 'resize cols
End With
End Sub


Regards

Paul
 
Back
Top