vba indexed search syntax

[parkerbelt]

I have an Excel workbook that has a sheet that has a list of 500 stores numbered Store number 1, store number 7 store number 11, etc.. - these are my test stores. The store number is in column A. I'm calling this sheet "500 Test Stores". The sheet doesn't contain duplicate store numbers, it is an index if you will.

I have another Excel workbook that has a large list of store data, which includes store number in column A along with Sales data in a different column and Quantity on-hand in another column, and other data in other columns, etc.. I'm calling this sheet "Test Dump". This sheet contains multiple store numbers that are the same, because the data goes with different items that are sold at the same store.

I'm trying to write a program that will look at each cell in column A of the 500 Test Stores sheet and look for a match in the Test Dump sheet and if it finds a match, copy the row of data where the match is and paste it into a different tab that I call "Test Stores Data".
If the store number doesn't match, I want to copy the row of data into a tab called "All Other Stores Data".

I'm a bit inexperienced and rusty - and each time I try to create my loops, I keep duplicating data and the program is really in-efficient.
Does anyone know how to write the code so that my loop is efficient, it sorts the data like I want it to and it doesn't duplicate any data?

Here's what I've attempted, but it is going to duplicate data if allowed to run through:

Dim SearchStore As LongDim lastrow500 As LongDim lastrow As Long           Sheets("500 Test Stores").Select    lastrow500 = Cells(Rows.Count, "A").End(xlUp).Row        Sheets("Temp Dump").Select    lastrow = Cells(Rows.Count, "A").End(xlUp).Row    Dim i As Long        i = 2
Dim its As Long        its = 2
Dim iao As Long
    iao = 2
Dim itsl As Long        itsl = 2

' Start of loop for Test Stores

Do Until itsl = lastrow500 + 1
    Sheets("500 Test Stores").Select
    SearchStore = Range("A" & its).Value.Select        
    Do Until i = lastrow + 1
                Sheets("Temp Dump").Select            Range("A" & i).Select

        If Range("A" & i).Value = SearchStore Then            Rows(ActiveCell.Row).Select            Selection.Copy            Sheets("Test Stores Data").Select            Range("A" & i).Select            ActiveSheet.Paste            i = i + 1            its = its + 1                    Else            Rows(ActiveCell.Row).Select            Selection.Copy            Sheets("All Other Stores Data").Select            Range("A" & iao).Select            ActiveSheet.Paste            iao = iao + 1            i = i + 1                    End If            Loop
    itsl = itsl + 1    Loop

 

[DanteAmor]

Try this to fill only "Test Stores Data" sheet.

Sub search_numbers_2()
    Dim lr1 As Long, lr2 As Long
    
    Sheets("Test Stores Data").Cells.ClearContents
    
    lr1 = Sheets("500 Test Stores").Range("A" & Rows.Count).End(xlUp).Row
    lr2 = Sheets("Temp Dump").Range("A" & Rows.Count).End(xlUp).Row
    
    Sheets("Temp Dump").Range("A1:X" & lr2).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Temp Dump").Range("A1:A" & lr1), _
        CopyToRange:=Sheets("Test Stores Data").Range("A1:X1"), Unique:=False


    MsgBox "Done"
End Sub

I'll try to fill out the "All Other Stores Data" sheet to make it faster

 

[parkerbelt]

How many records do you have on the "temp dump" sheet?

Only 9857

 

[DanteAmor]

Only 9857

The macro reads one by one. Try the macro in post #11

 

[parkerbelt]

I can't try it until I figure out how to enable macros - the option is greyed out and won't let me change it. Not sure what's wrong yet.

The macro reads one by one. Try the macro in post #11

 

[DanteAmor]

I can't try it until I figure out how to enable macros - the option is greyed out and won't let me change it. Not sure what's wrong yet.

ok, I check something on that and I'll let you know if I find a solution

 

[parkerbelt]

Try this to fill only "Test Stores Data" sheet.

Sub search_numbers_2()
    Dim lr1 As Long, lr2 As Long
    
    Sheets("Test Stores Data").Cells.ClearContents
    
    lr1 = Sheets("500 Test Stores").Range("A" & Rows.Count).End(xlUp).Row
    lr2 = Sheets("Temp Dump").Range("A" & Rows.Count).End(xlUp).Row
    
    Sheets("Temp Dump").Range("A1:X" & lr2).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Temp Dump").Range("A1:A" & lr1), _
        CopyToRange:=Sheets("Test Stores Data").Range("A1:X1"), Unique:=False


    MsgBox "Done"
End Sub

I'll try to fill out the "All Other Stores Data" sheet to make it faster

I tried your code and it copied 521 rows of data from the "Temp Dump" tab and pasted it into the "Test Stores Data" tab, but it didn't filter out any of the stores that weren't in the "500 Test Stores" tab.

 

[DanteAmor]

I tried your code and it copied 521 rows of data from the "Temp Dump" tab and pasted it into the "Test Stores Data" tab, but it didn't filter out any of the stores that weren't in the "500 Test Stores" tab.

That's what my post says:

Try this to fill only "Test Stores Data" sheet.
I'll try to fill out the "All Other Stores Data" sheet to make it faster

The 521 records are correct?

 

[parkerbelt]

That's what my post says:




The 521 records are correct?

No

 

[DanteAmor]

No

You can upload a sample of your file.

You could upload a copy of your file to a free site such www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[parkerbelt]

You can upload a sample of your file.

You could upload a copy of your file to a free site such www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

This ended up working. Something must have been wrong with the CopyToRange that you sent.

Sheets("Temp Dump").Select        Range("A1").Select    Range(Selection, Selection.End(xlDown)).Select    Application.CutCopyMode = False    Application.CutCopyMode = False    Application.CutCopyMode = False    Range("A1:X" & lr2).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _        Sheets("500 Test Stores").Range("A1:A" & lr1), Unique:=False        Range("A2").Select    Range(Selection, Selection.End(xlToRight)).Select    Range(Selection, Selection.End(xlDown)).Select    Selection.SpecialCells(xlCellTypeVisible).Select    Selection.Copy    Sheets("Test Stores Data").Select    Range("A2").Select    ActiveSheet.Paste        Sheets("Temp Dump").Select

Now I need to figure out the "All Other Stores Data" piece