One column with data, delete rows NOT containing data

[stags81]

Hello all,

I have a list of data in Column A in Sheet 1, and in Sheet 2 I have 1000s of rows where that data may appear once, multiple times, or not at all. I would like to delete all rows NOT containing the data in Column A from Sheet 2. How can I do this? Let me know if you need more information.

Thanks!

Mike

 

[AlphaFrog]

Try something like this. First test it on a copy of your data.

[color=darkblue]Sub[/color] Delete_Rows()
    
    [color=darkblue]Dim[/color] A, B, r&
    [color=darkblue]Dim[/color] Dict [color=darkblue]As[/color] [color=darkblue]Object[/color]
    
    [color=darkblue]With[/color] Sheets("Sheet1")
        A = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
    End [color=darkblue]With[/color]
    
    [color=darkblue]Set[/color] Dict = CreateObject("Scripting.Dictionary")
    Dict.CompareMode = 1
    [color=darkblue]For[/color] r = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](A, 1)
        Dict(A(r, 1)) = r
    [color=darkblue]Next[/color] r
    
    
    [color=darkblue]With[/color] Sheets("Sheet2")
        B = .Range("A1", .Range("A" & Rows.Count).[color=darkblue]End[/color](xlUp)).Value
    End [color=darkblue]With[/color]
           
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]For[/color] r = [color=darkblue]UBound[/color](B, 1) [color=darkblue]To[/color] 1 [color=darkblue]Step[/color] -1
        [color=darkblue]If[/color] [color=darkblue]Not[/color] Dict.exists(B(r, 1)) [color=darkblue]Then[/color] Sheets("Sheet2").Rows(r).Delete
    [color=darkblue]Next[/color] r
    Application.ScreenUpdating = [color=darkblue]True[/color]
        
End [color=darkblue]Sub[/color]

 

[stags81]

Hello,

Thanks for the help...I do have a couple concerns:

In Sheet1, cell A1, I have one piece of data, and upon running the macro I get a "type mismatch" error, for which this part of the code is highlighted:

"For r = 1 To UBound(A, 1)".

I copied and pasted the same data from A1 into A2, and the macro ran without errors...except it deleted ALL of the data in Sheet2. Ideally, I'd like it to delete only the rows NOT containing the data from Column A in Sheet1, and shifting the rows of the sheet up.

FYI...if the data from Sheet1 is found in Sheet2, it will be in Column E of Sheet2. I hope this simplifies the code a bit. Not sure if we can somehow add in an error box if, for whatever reason, the data is not found in Sheet2?

Thank you again for your assistance! Let me know if I can clarify anything for you.

-Mike

Try something like this. First test it on a copy of your data.

[COLOR=darkblue]Sub[/COLOR] Delete_Rows()
    
    [COLOR=darkblue]Dim[/COLOR] A, B, r&
    [COLOR=darkblue]Dim[/COLOR] Dict [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    
    [COLOR=darkblue]With[/COLOR] Sheets("Sheet1")
        A = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
    End [COLOR=darkblue]With[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] Dict = CreateObject("Scripting.Dictionary")
    Dict.CompareMode = 1
    [COLOR=darkblue]For[/COLOR] r = 1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](A, 1)
        Dict(A(r, 1)) = r
    [COLOR=darkblue]Next[/COLOR] r
    
    
    [COLOR=darkblue]With[/COLOR] Sheets("Sheet2")
        B = .Range("A1", .Range("A" & Rows.Count).[COLOR=darkblue]End[/COLOR](xlUp)).Value
    End [COLOR=darkblue]With[/COLOR]
           
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]For[/COLOR] r = [COLOR=darkblue]UBound[/COLOR](B, 1) [COLOR=darkblue]To[/COLOR] 1 [COLOR=darkblue]Step[/COLOR] -1
        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Dict.exists(B(r, 1)) [COLOR=darkblue]Then[/COLOR] Sheets("Sheet2").Rows(r).Delete
    [COLOR=darkblue]Next[/COLOR] r
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
        
End [COLOR=darkblue]Sub[/COLOR]

 

[AlphaFrog]

[color=darkblue]Sub[/color] Delete_Rows()
    
    [color=darkblue]Dim[/color] A, B, r&
    [color=darkblue]Dim[/color] Dict [color=darkblue]As[/color] [color=darkblue]Object[/color]
    
    [color=darkblue]With[/color] Sheets("Sheet1")
        r = .Range("A" & Rows.Count).End(xlUp).Row
        [color=darkblue]If[/color] r = 1 [color=darkblue]Then[/color]
            [color=darkblue]ReDim[/color] A(1 [color=darkblue]To[/color] 1, 1 [color=darkblue]To[/color] 1)
            A(1, 1) = .Range("A1").Value
        [color=darkblue]Else[/color]
            A = .Range("A1:A" & r).Value
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]Set[/color] Dict = CreateObject("Scripting.Dictionary")
    Dict.CompareMode = 1
    [color=darkblue]For[/color] r = 1 [color=darkblue]To[/color] [color=darkblue]UBound[/color](A, 1)
        Dict(A(r, 1)) = r
    [color=darkblue]Next[/color] r
    
    
    [color=darkblue]With[/color] Sheets("Sheet2")
        B = .Range("E1", .Range("E" & Rows.Count).End(xlUp)).Value
    [color=darkblue]End[/color] [color=darkblue]With[/color]
           
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]For[/color] r = [color=darkblue]UBound[/color](B, 1) To 1 [color=darkblue]Step[/color] -1
        [color=darkblue]If[/color] [color=darkblue]Not[/color] Dict.exists(B(r, 1)) [color=darkblue]Then[/color] Sheets("Sheet2").Rows(r).Delete
    [color=darkblue]Next[/color] r
    Application.ScreenUpdating = [color=darkblue]True[/color]
        
End [color=darkblue]Sub[/color]