If(isnumber(search) vba

Question

I have the following table:

┌────────────────────────────────┬──┬──┬──┬──┬──┬──┬──┬─────┬──┬──┬──┬───┐
│               I                │  │  │  │  │  │  │  │   L │  │  │  │ S │
├────────────────────────────────┼──┼──┼──┼──┼──┼──┼──┼─────┼──┼──┼──┼───┤
│                                │  │  │  │  │  │  │  │     │  │  │  │   │
│ Mr John Smith                  │  │  │  │  │  │  │  │     │  │  │  │   │
│ Mr Jack Paul and Mrs Jack Paul │  │  │  │  │  │  │  │     │  │  │  │   │
└────────────────────────────────┴──┴──┴──┴──┴──┴──┴──┴─────┴──┴──┴──┴───┘

My VBA code is:

Sub x()
    Dim TR As Long
    TR = Cells(Rows.Count, "I").End(xlUp).Row
    Range("L2:L" & TR) = Evaluate("IF(ISNUMBER(SEARCH(""MR"",I2:I" & TR & ")),""Dear Sir"","""")")
    Dim SS As Long
    SS = Cells(Rows.Count, "L").End(xlUp).Row
    Range("S2:S" & SS) = Evaluate("IF(ISNUMBER(SEARCH(""Dear Sir"",L2:L" & SS & ")),""your banking facility"","""")")
End Sub

What I want is:

If in column I there are Mr and Mrs then column L= Dear Sir/Madam, and if L= Dear Sir/Madam then Column S= your banking facilities.

With Mr its works well.

QHarr · Accepted Answer

2 versions

Version 1 As per your updated comments - Looping sheets with format as specified.

Version 2 Where you can use a dictionary and a search term

Version 1

Structure for looping sheets and if customer search term varies (covered by ElseIfs)

At present set up to loop 2 sheets. I have set the:

custNameColumn : Expected customer name column = A
salutationColumn Expected salutation column = 2 ("B")
commentColumn Expected banking comment column = 3 ("C")
targetFirstRow Row in each sheet where first customer name is = 2

These can be changed in the code but must be consistent across sheets.

It is not the most efficient method, but you couldn't use the Evaluate method as it is currently set-up so this is a an easy alternative rather than getting into more complicated code.

You can add additional ElseIf statements for more search terms e.g. Master

You can add more sheets to sheetsArr

Option Explicit

  Sub test()

        Dim wb As Workbook
        Dim wsTarget As Worksheet
        Dim targetRange As Range

        Set wb = ThisWorkbook

        Dim sheetsArr()
        sheetsArr = Array("Sheet1", "Sheet2")

        Const custNameColumn As String = "A" 'column where customer name is
        Const salutationColumn As Long = 2 'column where "Dear" goes
        Const commentColumn As Long = 3 'column where "Banking goes"
        Const targetFirstRow As Long = 2 'row where first customer name is

        Dim targetLastRow As Long
        Dim currentSheet As Long

        For currentSheet = LBound(sheetsArr) To UBound(sheetsArr)
          '  On Error Resume Next
            Set wsTarget = wb.Worksheets(sheetsArr(currentSheet))
          '  On Error GoTo 0
            targetLastRow = wsTarget.Cells(Rows.Count, custNameColumn).End(xlUp).Row

            Set targetRange = wsTarget.Range(custNameColumn & targetFirstRow & ":" & custNameColumn & targetLastRow)

            Dim currentCell As Range

            For Each currentCell In targetRange

                If InStr(1, LCase$(currentCell), "mr ", vbBinaryCompare) > 0 And _
                    InStr(1, LCase$(currentCell), "mrs ", vbBinaryCompare) > 0 Then

                    currentCell.Offset(, salutationColumn - 1) = "Dear Sir/Madame"
                    currentCell.Offset(, commentColumn - 1) = "Banking Facilities"

                ElseIf InStr(1, LCase$(currentCell), "mr and mr", vbBinaryCompare) > 0 Then

                    currentCell.Offset(, salutationColumn - 1) = "Dear Mssrs"
                    currentCell.Offset(, commentColumn - 1) = "Banking Facilities"

                ElseIf InStr(1, LCase$(currentCell), "mrs ", vbBinaryCompare) > 0 Then

                     currentCell.Offset(, salutationColumn - 1) = "Dear Madame"
                     currentCell.Offset(, commentColumn - 1) = "Banking Facility"

                ElseIf InStr(1, LCase$(currentCell), "mr ", vbBinaryCompare) > 0 Then

                     currentCell.Offset(, salutationColumn - 1) = "Dear Sir"
                     currentCell.Offset(, commentColumn - 1) = "Banking Facility"

                ElseIf InStr(1, LCase$(currentCell), "miss ", vbBinaryCompare) > 0 Then

                     currentCell.Offset(, salutationColumn - 1) = "Dear Miss"
                     currentCell.Offset(, commentColumn - 1) = "Banking Facility"
                End If

            Next currentCell

        Next currentSheet

    End Sub

Version 2:

So you could put the searchTerm in a variable. Note I have used a dictionary to hold the Title and the associated salutation. You can just extend this dictionary for new items.

If you have multiple different search terms, I am not sure evaluate, used in this manner, is the right way to go about it.

To use Evaluate in this manner you want ranges of equal length so you can do away with SS and just use TR.

Option Explicit

Sub x()

    With ActiveSheet

    Dim TR As Long
    TR = .Cells(Rows.Count, "I").End(xlUp).Row

    Dim searchTerm As String

    searchTerm = "Mr and Mr"

    Dim salutationDictionary As Object

    Set salutationDictionary = CreateObject("Scripting.Dictionary")

    salutationDictionary.Add "Mr", "Dear Sir"
    salutationDictionary.Add "Mrs", "Dear Madame"
    salutationDictionary.Add "Ms", "Dear Miss"
    salutationDictionary.Add "Mr and Mr", "Mssrs" 'keep adding here

    Dim bankingComment As String

    Select Case searchTerm

    Case "Mr", "Mrs", "Ms"  ' - singular cases add here
       bankingComment = "your banking facility"
    Case Else
        bankingComment = "your banking facilities"
    End Select

    .Range("L2:L" & TR) = Evaluate("IF(ISNUMBER(SEARCH(""" & searchTerm & """,I2:I" & TR & ")),""" & salutationDictionary(searchTerm) & ""","""")")
    .Range("S2:S" & TR) = Evaluate("IF(ISNUMBER(SEARCH(""" & salutationDictionary(searchTerm) & """,L2:L" & TR & ")),""" & bankingComment & ""","""")")


    End With

End Sub

If(isnumber(search) vba

Answers (2)

Related Questions