Reputation: 1
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