Switching the VBA MessageBox for a selection in a fixed range instead

user_18163134 0
Viewed 64

So my code was made to select any row where the entered name will be present in the active worksheet. Rather than typing the names one by one in the message box, I was wondering if it could do the same function with multiple names in another tab called 'Leaving Staff' in Column A (range A2 to A100).

Here is my code:

 Sub Leaving_Employee()
 Dim Rng As Range
 Dim myCell As Object
 Dim myUnion As Range
 Set Rng = ActiveSheet.Range("A2:AN50000")
 searchString = InputBox("Welcome! Please Enter the Full Name")
 For Each myCell In Rng
 If InStr(myCell.Text, searchString) Then
      If Not myUnion Is Nothing Then
          Set myUnion = Union(myUnion, myCell.EntireRow)
      Else
          Set myUnion = myCell.EntireRow
      End If
 End If
 Next
 If myUnion Is Nothing Then
     MsgBox "The employee was not found in the selection"
 Else
     myUnion.Select
 End If
 End Sub
vba excel
2 Answers

Matching Criteria From Another Worksheet

Option Explicit

Sub Leaving_Employee()

    ' Destination
    Dim dws As Worksheet: Set dws = ActiveSheet
    Dim drg As Range
    With dws.Columns("A:AN").Resize(dws.Rows.Count - 1).Offset(1)
        Dim lCell As Range
        Set lCell = .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If lCell Is Nothing Then Exit Sub ' no data
        Set drg = dws.Range("A2:AN" & lCell.Row)
    End With

    ' Workbook
    Dim wb As Workbook: Set wb = dws.Parent

    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets("Leaving Staff")
    Dim srg As Range
    With sws
        Set srg = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
    End With

    ' Loop.
    Dim myUnion As Range
    Dim rrg As Range
    Dim myCell As Range
    For Each rrg In drg.Rows
        For Each myCell In rrg.Cells
            If Not IsError(myCell.Value) Then ' exclude error values
                If Len(myCell.Value) > 0 Then ' exclude blanks
                    If IsNumeric(Application.Match(myCell.Value, srg, 0)) Then
                        If Not myUnion Is Nothing Then
                            Set myUnion = Union(myUnion, myCell)
                        Else
                            Set myUnion = myCell
                        End If
                        Exit For
                    End If
                End If
            End If
        Next myCell
    Next rrg

    ' Select or inform of failure.
    If myUnion Is Nothing Then
        MsgBox "The employee was not found in the selection"
    Else
        myUnion.EntireRow.Select
    End If

 End Sub
user_98140690

You can just create a loop that cycles through the leaver list like so:

Sub Leaving_Employee()
Dim Rng As Range
Dim myCell As Object
Dim myUnion As Range
Set Rng = ActiveSheet.Range("A2:AN50000")

For Each searchString In Worksheets("Leaving Staff").Range("A2:A100").Cells

   For Each myCell In Rng
   If InStr(myCell.Text, searchString.value) Then
        If Not myUnion Is Nothing Then
            Set myUnion = Union(myUnion, myCell.EntireRow)
        Else
            Set myUnion = myCell.EntireRow
        End If
   End If
   Next

Next

If myUnion Is Nothing Then
    MsgBox "No employees were found in the selection"
Else
    myUnion.Select
End If
End Sub

You may also want to ensure that all cells in the A2:A100 range have something in them. Otherwise, you need to use an If..Then statement to only run the inner loop when searchString <> ""

UPDATE

The following routine is a rewrite that copies the contents of both the ranges into arrays before doing the tests. This should be much faster.

Sub Leaving_Employee_using_arrays()
    
    Dim myUnion As Range, arrData As Variant, arrSrch As Variant, Rng As Range, Srch As Range
    
    ' set ranges
    Set Rng = Union(ActiveSheet.Range("A2:AN50000"), ActiveSheet.UsedRange)
    Set Srch = Worksheets("Leaving Staff").Range("A2:A100")
    
    ' copy range into array
    arrData = Rng.Value
    
    ' copy search range into array
    arrSrch = Srch.Value
    
    For Y = 1 To UBound(arrData, 1)             ' Y is row
        For X = 1 To UBound(arrData, 2)         ' X is column
            For Z = 1 To UBound(arrSrch, 1)     ' Z is search array index
                If InStr(arrData(Y, X), arrSrch(Z, 1)) Then
                    If Not myUnion Is Nothing Then
                        Set myUnion = Union(myUnion, ActiveSheet.Rows(Y).EntireRow)
                    Else
                        Set myUnion = ActiveSheet.Rows(Y).EntireRow
                    End If
                    Exit For
                End If
            Next
        Next
    Next
    If myUnion Is Nothing Then
        MsgBox "No employees were found in the selection"
    Else
        myUnion.Select
    End If

End Sub
user_74467600
Related