CODEWITHSUNDEEP
excelvbastring
Dennis Christiansen
Dennis Christiansen

Reputation: 165

VBA - Find exact match of a name in a string

I'm trying to create this tool that will, by looking through a list of expenses, be able to calculate the amount owed to each employee. So from our account software I can export an excel document with 2 columns. The first column have the amount and the second will have the following strings:

"Lunch, outlay Tanne"

"Train ticket, outlay Anne"

"Lunch, outlay Dennis"

"Lunch, outlay Anne"

The excel document will then look through all the expenses and calculate the total amount owed to each person. So far I've used the following code to calculate the total amounts (some of the variables are calculated earlier, this is just the part calculating the total amount):

'Calcualte total amount
   For i = 1 To NamesTotal
       TotalAmount = 0
       NameString = UCase(Cells(i + 1, 7))
       For j = 1 To EntriesTotal
           CellText = UCase(Cells(j + 2, 3))
               If InStr(1, CellText, NameString) Then
                   Amount = Cells(j + 2, 4)
                   TotalAmount = TotalAmount + Amount         
               End If
           End If
       Next

       Cells(TableStart + i, 3) = Cells(i + 1, 7)
       Cells(TableStart + i, 4) = TotalAmount
       Cells(TableStart + i, 4).NumberFormat = "#,##0.00"
    Next

The list of names is listed in column 7, the strings in column 3 and amount in column 4. The list works fine (I have a little more code) but the problem lies with names very similar to each other

If InStr(1, CellText, NameString) Then

In my example above the name "Anne" is part of the name "Tanne" so the list for Tanne will include the expenses for Anne as well. So how do I change the code so that it will find the exact match?

Upvotes: 1

Views: 3786

Answers (2)

Vasily
Vasily

Reputation: 5782

one of the possible solutions (the way to achieve required result):

Function getval(searchStr As String, rng As Range) As String
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim cl As Range, wrd
    For Each cl In rng
        For Each wrd In Split(Replace(cl.Value2, ",", ""))
            If LCase(wrd) = LCase(searchStr) Then dic.Add cl.Value2, ""
    Next wrd, cl
    getval = Join(dic.keys, vbNewLine)
End Function

testenter image description here

Upvotes: 0

QHarr
QHarr

Reputation: 84465

You could write a regex function that looks for the name as a word using word boundary syntax i.e. \bName\b

In my example the arguments to the function equate to CellText, NameString

Try it here.

Option Explicit

Public Sub TEST()
    Dim rng As Range
    For Each rng In [A1:A4]
       If IsNamePresent(rng.Value, "Anne") Then
           'do something
       End If
    Next
End Sub

Public Function IsNamePresent(ByVal inputString As String, testName As String)
    IsNamePresent = False
    With CreateObject("vbscript.regexp")
        .Global = True
        .MultiLine = True
        .IgnoreCase = False '<== You may want to change this
        .Pattern = "\b" & testName & "\b"
        If .TEST(inputString) Then IsNamePresent = True
    End With
End Function

Test values:

enter image description here

Regex:

\bAnne\b / gm

\b assert position at a word boundary (^\w|\w$|\W\w|\w\W)

Anne matches the characters Anne literally (case sensitive)

\b assert position at a word boundary (^\w|\w$|\W\w|\w\W).

So, must be Anne as a word and not Anne as part of a longer string.

Upvotes: 1

Related Questions