babyGirl

 Sub Select_Bulk_Data_InputBox()


    Dim ws As Worksheet

    Dim rng As Range

    Dim cell As Range

    Dim inputData As String

    Dim searchValues() As String

    Dim i As Long, j As Long

    Dim cellValue As String

    Dim selRange As Range

    Dim lastCol As Long

    Dim searchText As String

    Dim colInput As String

    Dim colNumbers() As String

    Dim colNum As Long

    Dim validCols As Collection

    Dim removeChars As String

    Dim removeList() As String

    Dim k As Long


    ' Sheet reference

    Set ws = ThisWorkbook.Sheets("Data 1")

    Set rng = ws.UsedRange

    

    ' Clear previous selection

    ws.Cells(1, 1).Select

    

    ' Step 1: Get bulk data from user

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

    

    ' Exit if cancelled or empty

    If Trim(inputData) = "" Then Exit Sub

    

    ' Replace tabs, line breaks, and spaces with commas

    searchText = inputData

    searchText = Replace(searchText, vbTab, ",")

    searchText = Replace(searchText, vbCrLf, ",")

    searchText = Replace(searchText, vbLf, ",")

    searchText = Replace(searchText, " ", ",")

    

    ' Remove duplicate commas (handles multiple spaces/tabs)

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

        searchText = Replace(searchText, ",,", ",")

    Loop

    

    ' Remove leading/trailing commas

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

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

    

    ' Split input into array

    searchValues = Split(searchText, ",")

    

    ' Step 2: Ask user if they want to remove certain characters

    removeChars = InputBox("Enter characters to remove from each value (no commas, e.g., _GL( ) or leave blank if none):", "Remove Characters")

    

    ' If user entered characters, clean each value

    If Trim(removeChars) <> "" Then

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

            For k = 1 To Len(removeChars)

                searchValues(i) = Replace(searchValues(i), Mid(removeChars, k, 1), "")

            Next k

            searchValues(i) = Trim(searchValues(i))

        Next i

    End If

    

    ' Step 3: Ask user which columns to select

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

    

    ' Exit if cancelled

    If Trim(colInput) = "" Then Exit Sub

    

    ' Split columns and validate

    colNumbers = Split(colInput, ",")

    Set validCols = New Collection

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

        colNum = Val(Trim(colNumbers(i)))

        If colNum > 0 Then validCols.Add colNum

    Next i

    

    ' Find last used column

    lastCol = rng.Columns.Count

    

    ' Step 4: Search for matching rows and select only specified columns

    For Each cell In rng

        If cell.Value <> "" Then

            cellValue = Trim(CStr(cell.Value))

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

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

                    ' Add selected columns only

                    For j = 1 To validCols.Count

                        If selRange Is Nothing Then

                            Set selRange = ws.Cells(cell.Row, validCols(j))

                        Else

                            Set selRange = Union(selRange, ws.Cells(cell.Row, validCols(j)))

                        End If

                    Next j

                    Exit For

                End If

            Next i

        End If

    Next cell

    

    ' Step 5: Highlight the found cells

    If Not selRange Is Nothing Then

        selRange.Select

        MsgBox "? Bulk data processed and selected successfully!" & vbCrLf & _

               "Removed characters: " & IIf(removeChars = "", "None", removeChars), vbInformation

    Else

        MsgBox "?? No matching cells found.", vbExclamation

    End If


End Sub



Comments

Post a Comment

Popular posts from this blog

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   ...
Read more

fixed 😃😃😃

Sub Select_Bulk_Data_InputBox_Final3()     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 resultSheet 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     Dim isFound As Boolean     Dim msgText As String ...
Read more