fixed

Sub Select_Bulk_Data_InputBox_Final2()

    Dim sheetName As String

    sheetName = "Data 1" ' <<-- Change the sheet name here only (exact name)

    Dim wb As Workbook

    Dim ws As Worksheet

    Dim rng As Range

    Dim inputData As String

    Dim arrInput As Variant

    Dim searchValues() As String

    Dim cleanedValues() As String

    Dim removeChars As String

    Dim arrRemove As Variant

    Dim removeProvided As Boolean

    Dim colInput As String

    Dim arrCols As Variant

    Dim validCols As Collection

    Dim foundSheet As Worksheet, notFoundSheet As Worksheet

    Dim i As Long, j As Long, k As Long

    Dim cell As Range

    Dim cellValue As String

    Dim lastCol As Long

    Dim foundCount As Long, notFoundCount As Long

    Dim isFound As Boolean

    Dim msgText As String

    Dim cleaned As String

    On Error GoTo ErrHandler

    Application.ScreenUpdating = False

    Application.EnableEvents = False

    Set wb = ThisWorkbook

    ' Check sheet existence once using the sheetName variable

    If Not SheetExists(sheetName, wb) Then

        MsgBox "Sheet named '" & sheetName & "' not found. Change the sheetName at the top of the macro and try again.", vbExclamation, "Missing Sheet"

        GoTo CleanExit

    End If

    Set ws = wb.Worksheets(sheetName)

    Set rng = ws.UsedRange

    If rng Is Nothing Then

        MsgBox "No used range found on sheet '" & sheetName & "'.", vbExclamation, "Empty Sheet"

        GoTo CleanExit

    End If

    lastCol = rng.Columns.Count

    ' Step 1: Get bulk input

    inputData = InputBox("Paste your bulk data here (comma, space, tab, or line-break separated):", "Bulk Data Select")

    If Trim(inputData) = "" Then GoTo CleanExit

    ' Normalize separators to commas

    inputData = Replace(inputData, vbTab, ",")

    inputData = Replace(inputData, vbCrLf, ",")

    inputData = Replace(inputData, vbLf, ",")

    inputData = Replace(inputData, " ", ",")

    ' Remove duplicate commas

    Do While InStr(inputData, ",,") > 0

        inputData = Replace(inputData, ",,", ",")

    Loop

    ' Trim leading/trailing commas

    If Len(inputData) > 0 Then

        If Left(inputData, 1) = "," Then inputData = Mid(inputData, 2)

        If Right(inputData, 1) = "," Then inputData = Left(inputData, Len(inputData) - 1)

    End If

    ' Split input into array (zero-based)

    arrInput = Split(inputData, ",")

    If Not IsArray(arrInput) Then GoTo CleanExit

    ReDim searchValues(LBound(arrInput) To UBound(arrInput))

    For i = LBound(arrInput) To UBound(arrInput)

        searchValues(i) = Trim(CStr(arrInput(i)))

    Next i

    ' Step 2: Get substrings to remove (optional)

    removeChars = InputBox("Enter substrings to remove if present (comma-separated, e.g. _,GL,AD) or leave blank:", "Remove Substrings")

    If Trim(removeChars) <> "" Then

        arrRemove = Split(removeChars, ",")

        removeProvided = True

        For i = LBound(arrRemove) To UBound(arrRemove)

            arrRemove(i) = Trim(CStr(arrRemove(i)))

        Next i

    Else

        removeProvided = False

        ReDim arrRemove(0 To -1) ' empty array

    End If

    ' Step 3: Prepare cleaned values (only remove when present)

    ReDim cleanedValues(LBound(searchValues) To UBound(searchValues))

    For i = LBound(searchValues) To UBound(searchValues)

        cleaned = searchValues(i)

        If removeProvided Then

            For k = LBound(arrRemove) To UBound(arrRemove)

                If arrRemove(k) <> "" Then

                    If InStr(cleaned, arrRemove(k)) > 0 Then

                        cleaned = Replace(cleaned, arrRemove(k), "")

                    End If

                End If

            Next k

        End If

        cleanedValues(i) = Trim(cleaned)

    Next i

    ' Step 4: Get columns to copy into Found sheet

    colInput = InputBox("Enter the column numbers you want to copy from " & sheetName & " (comma-separated, e.g., 1,3,6):", "Select Columns")

    If Trim(colInput) = "" Then GoTo CleanExit

    arrCols = Split(colInput, ",")

    Set validCols = New Collection

    For i = LBound(arrCols) To UBound(arrCols)

        Dim cnum As Long

        cnum = Val(Trim(arrCols(i)))

        If cnum > 0 And cnum <= lastCol Then

            validCols.Add cnum

        End If

    Next i

    If validCols.Count = 0 Then

        MsgBox "No valid columns selected or columns out of range 1 to " & lastCol & ".", vbExclamation, "Invalid Columns"

        GoTo CleanExit

    End If

    ' Step 5: Create / recreate result sheets safely

    On Error Resume Next

    Application.DisplayAlerts = False

    If SheetExists("Found_Results", wb) Then wb.Worksheets("Found_Results").Delete

    If SheetExists("Not_Found_Results", wb) Then wb.Worksheets("Not_Found_Results").Delete

    Application.DisplayAlerts = True

    On Error GoTo ErrHandler

    Set foundSheet = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))

    foundSheet.Name = "Found_Results"

    Set notFoundSheet = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))

    notFoundSheet.Name = "Not_Found_Results"

    ' Headers

    foundSheet.Cells(1, 1).Value = "Original Value"

    foundSheet.Cells(1, 2).Value = "Cleaned Value"

    For j = 1 To validCols.Count

        foundSheet.Cells(1, 2 + j).Value = "Col" & validCols(j)

    Next j

    notFoundSheet.Cells(1, 1).Value = "Original Value"

    notFoundSheet.Cells(1, 2).Value = "Cleaned Value"

    foundCount = 1

    notFoundCount = 1

    ' Step 6: Search each cleaned value across entire used range

    For i = LBound(cleanedValues) To UBound(cleanedValues)

        isFound = False

        If cleanedValues(i) <> "" Then

            For Each cell In rng

                If Len(Trim(CStr(cell.Value))) > 0 Then

                    cellValue = Trim(CStr(cell.Value))

                    If StrComp(cellValue, cleanedValues(i), vbTextCompare) = 0 Then

                        isFound = True

                        foundCount = foundCount + 1

                        foundSheet.Cells(foundCount, 1).Value = searchValues(i)

                        foundSheet.Cells(foundCount, 2).Value = cleanedValues(i)

                        ' copy requested associated columns from the same row

                        For j = 1 To validCols.Count

                            ' safe per-cell copy; if column index invalid for that sheet row, it will error skip

                            On Error Resume Next

                            foundSheet.Cells(foundCount, 2 + j).Value = ws.Cells(cell.Row, validCols(j)).Value

                            On Error GoTo ErrHandler

                        Next j

                        Exit For

                    End If

                End If

            Next cell

        End If

        If Not isFound Then

            notFoundCount = notFoundCount + 1

            notFoundSheet.Cells(notFoundCount, 1).Value = searchValues(i)

            notFoundSheet.Cells(notFoundCount, 2).Value = cleanedValues(i)

        End If

    Next i

    ' Step 7: Autofit and final message

    foundSheet.Columns.AutoFit

    notFoundSheet.Columns.AutoFit

    msgText = "Bulk search completed." & vbCrLf

    msgText = msgText & "Processed: " & (UBound(searchValues) - LBound(searchValues) + 1) & vbCrLf

    msgText = msgText & "Found: " & (foundCount - 1) & vbCrLf

    msgText = msgText & "Not Found: " & (notFoundCount - 1) & vbCrLf

    If Trim(removeChars) = "" Then

        msgText = msgText & "Removed substrings: None"

    Else

        msgText = msgText & "Removed substrings: " & removeChars

    End If

    MsgBox msgText, vbInformation, "Search Complete"

CleanExit:

    Application.ScreenUpdating = True

    Application.EnableEvents = True

    Exit Sub

ErrHandler:

    Application.ScreenUpdating = True

    Application.EnableEvents = True

    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Error"

End Sub

' Helper function to check if a sheet exists in workbook (avoids Error 9)

Private Function SheetExists(sName As String, wb As Workbook) As Boolean

    Dim tmp As Worksheet

    On Error Resume Next

    Set tmp = wb.Worksheets(sName)

    SheetExists = Not tmp Is Nothing

    On Error GoTo 0

End Function