Adapting a find/replace macro using dual array table to single array find & move or delete row macro

[wittonlin]

I've been working on this macro for some time now and now that I have it referencing an array table in my template workbook...

I'd like to use this array table idea to maintain a list of values that denote the entire row should be moved to another sheet or removed completely.

Below this code is a similar idea for finding and removing rows based on a small array list built right into the macro. (See macro 2.)

Any idea?


macro 1:

Sub FindReplace_Multi_ActivesheetOnly()

Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant
Dim wb As Workbook
Set wb = Workbooks("Personal.xlsb")

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

'Create variable to point to your table
  Set tbl = wb.Worksheets("Table1").ListObjects("Table13")

'Create an Array out of the Table's Data
  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)
  
'Designate Columns for Find/Replace data
  fndList = 1
  rplcList = 2

'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 2)
    'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
      'For Each sht In ActiveWorkbook.Worksheets
        'If sht.name <> tbl.Parent.name Then
          
          ActiveSheet.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
        
        'End If
      'Next sht
  Next x
  
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Sub

macro 2

Sub A1A1Find_Example()
    Dim calcmode As Long
    Dim ViewMode As Long
    Dim myStrings As Variant
    Dim FoundCell As Range
    Dim I As Long
    Dim myRng As Range
    Dim sh As Worksheet
    
     'We use the ActiveSheet but you can also use Sheets("MySheet")
    Set sh = ActiveSheet

    'We look in column A in this example
    Set myRng = sh.Range("A:A")

    'Add more search strings if you need
    myStrings = Array("Ron", "Dave", "Tom")

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'We use the ActiveSheet but you can also use Sheets("MySheet")
    Set sh = ActiveSheet

    'We search in column A in this example
    Set myRng = sh.Range("A:A")

    'Add more search strings if you need
    myStrings = Array("Ron", "Dave", "Tom")


    With sh

        'We select the sheet so we can change the window view
        .Select

        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False

        'We will search the values in MyRng in this example
        With myRng

            For I = LBound(myStrings) To UBound(myStrings)
                Do
                    Set FoundCell = myRng.Find(What:=myStrings(I), _
                                               After:=.Cells(.Cells.count), _
                                               LookIn:=xlFormulas, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                    'Use xlPart If you want to search in a part of the FoundCell
                    'If you use LookIn:=xlValues it will also delete rows with a
                    'formula that evaluates to "Ron"
                    If FoundCell Is Nothing Then
                        Exit Do
                    Else
                        FoundCell.EntireRow.Delete
                    End If
                Loop
            Next I

        End With

    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = calcmode
    End With

End Sub

 

[wittonlin]

Ok I got this one to work from the same source Ron de Bruin. He's got some great resources.

I need direction for two issues. One is with pointing to an array table in my template like the first macro vs just another sheet in the Activeworkbook.

And how can I MOVE the rows (when a certain column cell or any column cell match an array entry) to a new sheet or worksheet?

Sub Delete_with_Autofilter_More_Criteria()
    Dim rng As Range
    Dim cell As Range
    Dim CriteriaRng As Range
    Dim calcmode As Long

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    With Sheets("Criteria")
        Set CriteriaRng = .Range("A1", .Cells(Rows.Count, "A").End(xlUp))
    End With

    'Loop through the cells in the Criteria range
    For Each cell In CriteriaRng

        With Sheets("data")

            'Firstly, remove the AutoFilter
            .AutoFilterMode = False

            'Apply the filter
            .Range("A1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=cell.Value

            With .AutoFilter.Range
                Set rng = Nothing
                On Error Resume Next
                Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                          .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
                If Not rng Is Nothing Then rng.EntireRow.Delete
            End With

            'Remove the AutoFilter
            .AutoFilterMode = False
        End With

    Next cell

    With Application
        .ScreenUpdating = True
        .Calculation = calcmode
    End With
    
End Sub