Use VBA to display record with criteria

[Learn-more]

I know only a little about using VBA and now have a problem not sure how to
work it out. I need to display some records in a new sheet according to some
criteria,

Example in Sheet A
A B C D
1 Apple one Mon 1
2 Banana two Tue 2
3 Apple two Wed 5
4 Apple one Thu 6

Say I need to display in Sheet B the records that satisfy A=Apple and B=one
and also with a total for D

I know how to use ComboBox etc to crate the list but don’t know how to make
the selection and move to a new sheet.

Can anyone tell me how or show me some web site that I can find some examples.
Thanks so much.

 

[Mike H]

Hi,

You don't need VB, try this on any sheet with your data in sheet 2

=SUMPRODUCT((Sheet2!A1:A4="Apple")*(Sheet2!B1:B4="One")*(Sheet2!D14))

Mike

 

[Learn-more]

Hi Mike,

Thanks for the information. However, the file is big and what I need to do
is only to display the records meeting the criteria and not to display those
failed the checking. Also display each record is more important then the
total for Column D

It is also good if some functions can work it out.
Thanks.

 

[Dave Peterson]

I wouldn't copy my data to a new worksheet.

I'd add another column and use a formula like:

=and(a2="apple",b2="one")

Then drag this formula down the column.

Then I could use data|filter|autofilter to show the just the True's.

If I really wanted to copy that data to another sheet, I'd still use the same
technique, but just copy the visible cells after applying the filter.

 

[Don Guillett]

Data on sheet 1. Sheet 2 has headers on row 1 and criteria on row 2. Fire
from sheet 2

sub getdatatoothesheet()
With Sheets("sheet1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("a1:d" & lr).AutoFilter Field:=1, Criteria1:=Range("a2") ' "Apple"
.Range("a1:d" & lr).AutoFilter Field:=2, Criteria1:=Range("b2") ' "One"
.Range("a2:d" & lr).Copy Sheets("sheet2").Range("a3")
.Range("a1:d" & lr).AutoFilter
End With
End Sub

 

[Learn-more]

Hi Don,
I think that's what I want, however, as my VBA knowledge is still limited,
as I run the code, it come back with Run-time error "9", Subscript out of
range. I print out the help and tried a few things but still not get it
right.
Any idea why and how to fix it?

Thanks for helping.

 

[Don Guillett]

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

 

[Don Guillett]

A B C
D
apple one 25
Apple one Mon 1
Apple one Thu 6
Apple one Sat 8
Apple one Mon 10

I set up the destination sheet as above with criteria on row 2. Assigned the
macro to a shape and fired from there. If all else fails, send your workbook
to my address below.

 

[Learn-more]

Hi Don,
Finally got it work but need to have Row1 of Sheet1 (date) blank or put in a
heading, it will always display in Sheet2 or even mess up the display. Not
sure why.

Thanks a lot.

 

[Don Guillett]

Send your workbook to my address below along with a complete explanation

 

[Don Guillett]

I sent a workbook with

Sub getadvfilter()
On Error Resume Next
Sheets("sheet2").Range("a3:d100").ClearContents
With Sheets("sheet1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1" & lr).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Sheets("Sheet2").Range("A1:C2"), Unique:=True 'False
.Range("A2" & lr).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("a3")
.ShowAllData
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:c2")) Is Nothing Then Exit Sub
getadvfilter
End Sub

 

[Learn-more]

Hi Don,

It really works great

Thanks.

I sent a workbook with

Sub getadvfilter()
On Error Resume Next
Sheets("sheet2").Range("a3:d100").ClearContents
With Sheets("sheet1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1" & lr).AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Sheets("Sheet2").Range("A1:C2"), Unique:=True 'False
.Range("A2" & lr).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("a3")
.ShowAllData
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:c2")) Is Nothing Then Exit Sub
getadvfilter
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

 

[Don Guillett]

Glad to help