VBA code to search for matching cell values cut from one sheet and paste to another

[Greck71]

I have seen many posts like similar to this but none seem to do what I need. I sure hope you can help. I would like to be able to populate sheet3 range I10 to I109 with alpha numeric values (never the same and may not have values for all 100 cells). Then have a macro that will search for an exact match of all these populated values on sheet5 column A. When matches are found found cut from sheet5 (moving all remaining up leaving no blank cells) and paste those rows into sheet6 column A. Finally, sort column A on sheet6 A to Z then go back and clear contents on Sheet3 range I10 to I109.

Thank you for your time!

 

[L. Howard]

Hi Greck71, welcome to the board.

Give this a try. Copy code to a standard module.

Howard

Sub Sheet3_Col_I_ET_AL()
Dim s3Rng As Range, c As Range, rngFound As Range
Dim iRow As Long, aRow As Long

iRow = Sheets("Sheet3").Cells(Rows.Count, 9).End(xlUp).Row
aRow = Sheets("Sheet5").Cells(Rows.Count, 1).End(xlUp).Row

Set s3Rng = Sheets("Sheet3").Range("I10:I" & iRow)

For Each c In s3Rng

   With Sheets("Sheet5")
   
      Set rngFound = Sheets("Sheet5").Range("A1:A" & aRow).Find(What:=c, _
                                      LookIn:=xlValues, _
                                      LookAt:=xlWhole, _
                                      SearchOrder:=xlByRows, _
                                      SearchDirection:=xlNext, _
                                      MatchCase:=False)
 
    If Not rngFound Is Nothing Then
    
      rngFound.Cut Sheets("Sheet6").Range("A" & Rows.Count).End(xlUp)(2)
      
     Else
      '
    End If
   
   End With
 
Next
   
   With Sheets("Sheet6").Columns("A")
   
      .Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:= _
                                xlYes, Orientation:=xlTopToBottom
   End With
   
   s3Rng = ""
    
End Sub