Vfrdtyky

I'm super new to VBA and hoping I could get some help please ... I'm looking for a succinct way to remove rows from a sheet via Macro and the VBA samples I've tried I cant get to work. I'm hoping it's something simple :)

The macro would remove a row that DOES NOT contain a specific values (from a specific column) from within an array. I sort of had it working, and full disclosure, I've borrowed code from other examples. The latest sample I'm working with just deletes everything, the other sample I was working with deleted Acro32.exe, but kept everything else. So not yet arrived at a solution.

Background: I have a CSV output from an application auditing tool, which spits out tonnes of app data from various computers. That CSV data will be copied into my master 'reporting' spreadsheet. I am only interested in reviewing and keeping data about specific applications, namely Chrome.exe, Firefox.exe, Acro32.exe and Winword.exe. The application name is always found in Column F. So, any cell contents found in Column F, that DOES NOT contain a value in an array, that entire row needs to be deleted. Ideally :) and the remaining rows will only include apps I'm interested in as defined in the array.

Any thoughts would be appreciated.

Thanks

Public Function GetLastRow(ByVal rngToCheck As Range) As Long



    Dim rngLast As Range



    Set rngLast = rngToCheck.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious)



    If rngLast Is Nothing Then

        GetLastRow = rngToCheck.Row

    Else

        GetLastRow = rngLast.Row

    End If



End Function



Sub Apps_Formatting()



    Dim varList As Variant

    Dim lngLastRow As Long, lngCounter As Long

    Dim rngToCheck As Range, rngFound As Range

    Dim rngToDelete As Range, rngDifferences As Range

    Dim blnFound As Boolean



    Application.ScreenUpdating = False



    With ActiveSheet

    lngLastRow = GetLastRow(.Cells)



        'we don't want to delete our header row

        Set rngToCheck = .Range("A2:A" & lngLastRow)

    End With



    If lngLastRow > 1 Then



        With rngToCheck



            'any Cell in Column F that contains one of these values are KEPT

            'and if not found in cell, then the entire row is deleted. 



            varList = VBA.Array("Chrome.exe", "Firefox.exe", "Acro32.exe")



            For lngCounter = LBound(varList) To UBound(varList)



                Set rngFound = .Find( _

                                        what:=varList(lngCounter), _

                                        Lookat:=xlWhole, _

                                        searchorder:=xlByRows, _

                                        searchdirection:=xlNext, _

                                        MatchCase:=True)



                'check if we found a value we want to keep

                If Not rngFound Is Nothing Then



                    blnFound = True



                    'if there are no cells with a different value then

                    'we will get an error

                    On Error Resume Next

                    Set rngDifferences = .ColumnDifferences(Comparison:=rngFound)

                    On Error GoTo 0



                    If Not rngDifferences Is Nothing Then

                        If rngToDelete Is Nothing Then

                            Set rngToDelete = rngDifferences

                        Else

                            Set rngToDelete = Application.Intersect(rngToDelete, rngDifferences)

                        End If

                    End If



                End If



            Next lngCounter

        End With



        If rngToDelete Is Nothing Then

            If Not blnFound Then rngToCheck.EntireRow.Delete

        Else

            rngToDelete.EntireRow.Delete

        End If

    End If



    Application.ScreenUpdating = True



End Sub

To follow up on this thread, should someone else benefit, the code below was provided and worked really well.

Sub a1077712b()

'https://www.mrexcel.com/forum/excel-questions/1077712-vba-remove-rows-xlsx-where-particular-text-can-found-within-cell.html

Dim i As Long, r As Range

Dim va As Variant, arr As Variant, flag As Boolean

arr = Array("Chrome.exe", "Firefox.exe", "Acro32.exe", "Winword.exe")

Set r = Range("F2", Cells(Rows.count, "F").End(xlUp))

va = r



For i = 1 To UBound(va, 1)

    flag = False

        For Each x In arr

            If InStr(1, va(i, 1), x, 1) > 0 Then flag = True: Exit For

        Next

    If flag = False Then va(i, 1) = ""

Next



r = va

r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete



End Sub