Pauldevans84
Pauldevans84

Reputation: 1

Why isnt the VBA doing what its supposed to be doing?

I have a spreadsheet with multiple tabs, I want the macro to go through specific tabs and if column B doesnt contain one of the numbers from the array, then delete the row, but its not deleting the row?

I used Copilot to compile the script, please see below:

Sub OpenFileAndCheckSpecificSheets()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim specificTexts As Variant
    Dim found As Boolean
    Dim fd As FileDialog
    Dim filePath As String
    Dim folderPath As String
    Dim completedFolder As String
    Dim sheetNames As Variant
    Dim sheetName As Variant
    Dim cellValue As String
    
    ' Define the specific texts to check for
    specificTexts = Array("783729", "783726", "783786", "783794", "783793", "783827", "783829", "783830", "783831", "783832", "786304", "783825")
    
    ' Define the specific sheet names to check
    sheetNames = Array("Sheet1", "Sheet2") ' Add your specific sheet names here
    
    ' Open the file dialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.Title = "Select an Excel File"
    fd.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xlsb; *.xls"
    fd.AllowMultiSelect = False
    
    ' Show the dialog and get the selected file path
    If fd.Show = -1 Then
        filePath = fd.SelectedItems(1)
        folderPath = Left(filePath, InStrRev(filePath, "\"))
        completedFolder = folderPath & "Completed\"
        
        ' Create the Completed folder if it doesn't exist
        If Dir(completedFolder, vbDirectory) = "" Then
            MkDir completedFolder
        End If
    Else
        MsgBox "No file selected. Exiting..."
        Exit Sub
    End If
    
    ' Open the selected Excel file
    Set wb = Workbooks.Open(filePath)
    
    ' Loop through each specified sheet in the workbook
    For Each sheetName In sheetNames
        On Error Resume Next
        Set ws = wb.Worksheets(sheetName)
        On Error GoTo 0
        
        If Not ws Is Nothing Then
            lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
            
            ' Loop through each row in column B from B6 to the end
            For i = lastRow To 6 Step -1
                found = False
                cellValue = CStr(ws.Cells(i, 2).Value)
                
                ' Check if the cell value contains any of the specific texts
                For Each txt In specificTexts
                    If InStr(cellValue, txt) > 0 Then
                        found = True
                        Exit For
                    End If
                Next txt
                
                ' If the value is not found, delete the row
                If Not found Then
                    ws.Rows(i).Delete
                End If
            Next i
        End If
    Next sheetName
    
    ' Save the workbook in the completed folder
    wb.SaveAs completedFolder & wb.Name
    wb.Close SaveChanges:=True
End Sub

Upvotes: -2

Views: 103

Answers (0)

Related Questions