select records using VBA

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
 
B

Bob Phillips

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)
 
M

Meme

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,
 
B

Bob Phillips

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,
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)




.
 
M

Meme

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,
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]
=DATE
(2004,4,1)," & _
<=DATE
(2004,4,3)))"
.Range("E2").AutoFill Destination:=.Range
("E2:E"
& iLastRow),
Type:=xlFillDefault
.Columns("E:E").AutoFilter Field:=1,
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


.


.
 
P

Paulw2k

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top