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]

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

Did you change the macro code? in my tests it works well. that's why I need to see a part of your data with everything and headers to see how you have them in the sheets.

 

[parkerbelt]

Did you change the macro code? in my tests it works well. that's why I need to see a part of your data with everything and headers to see how you have them in the sheets.

I tried the code the way that you sent it and it didn't work with the copy to location part in it, so I recorded the Advanced Sort steps and used your lastrow designations and made it work. It is not as clean as the code that you sent, but it's still fast and it works. I just figured out a work around for the "All other Stores Data" tab. I made a copy of the "Temp Dump" sheet, while the filters were on, I deleted visible cells only. I then turned off the filters and copied the remaining data to the "All other Stores Data" tab. I think I'm good at this point, hopefully it will work well going forward. Thank you so much for your help!! You rock!

Here's the code I ended up with:

Dim lr1 As Long, lr2 As Long

    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").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
    
    Columns("A:X").Select
    Columns("A:X").EntireColumn.AutoFit
    Range("A1").Select
    
    Sheets("Temp Dump").Select


    ActiveSheet.Copy After:=ActiveSheet


    ActiveSheet.Name = "Working Dump Sheet"
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    
    Application.DisplayAlerts = False
    Selection.Delete
    
    ActiveSheet.ShowAllData
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("All Other Stores Data").Select
    Range("A2").Select
    ActiveSheet.Paste
    Columns("A:X").Select
    Columns("A:X").EntireColumn.AutoFit
    Range("A1").Select
    
    Sheets("Working Dump Sheet").Delete
    
    
    
    Application.DisplayAlerts = False
    Windows("Data.xlsm").Activate
    ActiveWindow.Close

 

[DanteAmor]

I tried the code the way that you sent it and it didn't work with the copy to location part in it, so I recorded the Advanced Sort steps and used your lastrow designations and made it work. It is not as clean as the code that you sent, but it's still fast and it works. I just figured out a work around for the "All other Stores Data" tab. I made a copy of the "Temp Dump" sheet, while the filters were on, I deleted visible cells only. I then turned off the filters and copied the remaining data to the "All other Stores Data" tab. I think I'm good at this point, hopefully it will work well going forward. Thank you so much for your help!! You rock!

I'm glad to know you found the result. Thanks for the feedback.