Loop through a worksheet and populate data into another worksheet if criteria is met

[mrexcelhelp123]

Hi There!

I have Sheet1 in workbook "DATA.xlsx" that has data. I.E.

column1 column2
567 John
567 May
123 Kate
567 Larry
456 Bill

I would like Sheet1 in ANOTHER workbook "SUMMARY.xlsx" to list all of the people who meet the number criteria I type in cell A1. For example, if I type in 567 in cell A1, then John, May, and Larry should be pull in and be listed in cell A2, A3, A4

Thanks for your help!

 

[btadams]

You can get most of the code you need by turning on the macro recorder, filtering column 1 to display only 567's, copy & paste to new workbook and turn off the macro recorder.

 

[VoG]

Perhaps a variation on http://www.mrexcel.com/forum/showthread.php?t=396069

 

[mrexcelhelp123]

Thanks for your help but this would mean I would need to create several macros. I have hundreds of different numbering that I want to pull in names for on many different worksheets.

 

[btadams]

but this would mean I would need to create several macros

This is not necessarily so. A single macro can be created to run thru an entire list of numbers, for example all the unique values in a given column.

 

[mrexcelhelp123]

O.k.,

So I tried what you said and here's the VBA code:

Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$B$8").AutoFilter Field:=1, Criteria1:="456"
Range("A1:B4").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows("After.xlsm").Activate
Range("A2").Select
ActiveSheet.Paste

Now, what if I have many After.xlsm sheets and I would like data to populate in these sheets depending on the Number I type in a cell. For example, if I type 456 in cell A1 in After456.xlsm then names from Data.xlsx populates automatically in A2, A3, etc. If I then type 758 in cel A1 for workbook After758.xlsm, names from DAta.xlsx would populate in A2, A3 and so forth.

Does this make sense? Thanks again for your help.

 

[btadams]

I'm not sure I completely understand what you want, but try this with copies of your workbooks:

Copy the code below, then right-mouse click on the worksheet where you will be entering "456" and choose View Code. Paste the code into the blank white area of the Visual Basic Editor. This code assumes you will be entering "456" in cell A1. Change if needed.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Address = "$A$1" Then FilterData

End Sub

With the VB editor still open go to the Insert menu and choose Module and paste the code below. This code assumes that the workbook After456.xlsm is already open. If this assumption is not valid we'll have to add some code to open the file.

Sub FilterData()
Dim strSourceWB As String

    strSourceWB = ActiveWorkbook.Name
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.UsedRange.AutoFilter Field:=1, Criteria1:=Range("A1").Value
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy
    Windows("After" & Range("A1").Value & ".xlsm").Activate
    Range("A2").Select
    ActiveSheet.Paste
    Workbooks(strSourceWB).Activate

End Sub