tricky (I think,lol) match and fill in

I am attempting to lookup, match, and then fill in data from one worksheet to another. For example, in the Data Scrub tab, I need to select the first entry "NCR CORPORATION', see if there is a close (fuzzy?) match in the 'EXTRACT' tab. Ah! There is! NCR CORPORATION-CHRS
" is the closest match. Then I need to copy that (NCR CORPORATION-CHRS) and paste it into A2 in the 'Data Scrub' tab..lastly,  I need to copy the Tier number from D18 on the 'Extract' tab and paste it into C3 on the 'Data Scrub' tab (and color it RED if possible, or mark it someway to note that it's changed)
I hope my explanation was clear. I understand the 'fuzziness' of matching may be an issue?
Book2.xlsx
singleton2787Asked:
Who is Participating?
 
TomasPCommented:
You create your reg expression string based on what you consider matches.
You use the Visual Studio wizard to creat an application in VB to read in the text to compare (files/cut and paste) and place each copy of the texts in a string. Use your expression and the string holding the text you wish to test as agruments to any of the functions listed here.
For example
LookIn holds the text from the document you wish to test
Pattern holds the regular expression
Pos is an offset in characters from the start of the LookIn string
MatchCase set to true means that the case of each word should be considered when matching words

Function RegExpFind(LookIn As String, PatternStr As String, Optional Pos, _
    Optional MatchCase As Boolean = True)
0
 
TomasPCommented:
The quickest way to do this is via VBA IMO. That way you can control color and copying directly.
You can also leverage the wizard for formulas to build a two step formula. One to detect the fuzzy match and a second to conditionally color the tab/cell
0
 
Patrick MatthewsCommented:
singleton2787,

RichardSchollar and I discuss a few different approaches for "fuzzy matching" here:

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24329564.html

Patrick
0
 
TomasPCommented:
I use regex all the time and I highly recommend regexbuddy to help construct the expressions. It can save a great deal of time by enabling you to test your expresson against test data before you plug it into VBA or VSTO
0
 
singleton2787Author Commented:
How do you actually use these functions?
Option Explicit
Function Soundex(InputStr As String) As String
' Based on function developed by Richard J. Yanco
' This function follows the Soundex rules given at
' http://home.utah-inter.net/kinsearch/Soundex.html
    Dim Result As String, c As String * 1
    Dim Location As Long
    InputStr = UCase(InputStr)
'   First character must be a letter
    If Asc(Left(InputStr, 1)) < 65 Or Asc(Left(InputStr, 1)) > 90 Then
        Soundex = ""
        Exit Function
    Else
'       Convert to Soundex: letters to their appropriate digit,
'                     A,E,I,O,U,Y ("slash letters") to slashes
'                     H,W, and everything else to zero-length string
        Result = Left(InputStr, 1)
        For Location = 2 To Len(InputStr)
            Result = Result & Category(Mid(InputStr, Location, 1))
        Next Location
      
'       Remove double letters
        Location = 2
        Do While Location < Len(Result)
            If Mid(Result, Location, 1) = Mid(Result, Location + 1, 1) Then
                Result = Left(Result, Location) & Mid(Result, Location + 2)
            Else
                Location = Location + 1
            End If
        Loop
    
'       If category of 1st letter equals 2nd character, remove 2nd character
        If Category(Left(Result, 1)) = Mid(Result, 2, 1) Then
            Result = Left(Result, 1) & Mid(Result, 3)
        End If
    
'       Remove slashes
        For Location = 2 To Len(Result)
            If Mid(Result, Location, 1) = "/" Then
                Result = Left(Result, Location - 1) & Mid(Result, Location + 1)
            End If
        Next
    
'       Trim or pad with zeroes as necessary
        Soundex = Left(Result & "0000", 4)
    End If
End Function
Private Function Category(c) As String
'   Returns a Soundex code for a letter
    Select Case True
        Case c Like "[AEIOUY]"
            Category = "/"
        Case c Like "[BPFV]"
            Category = "1"
        Case c Like "[CSKGJQXZ]"
            Category = "2"
        Case c Like "[DT]"
            Category = "3"
        Case c = "L"
            Category = "4"
        Case c Like "[MN]"
            Category = "5"
        Case c = "R"
            Category = "6"
        Case Else 'This includes vowels, Y, H and W, spaces, punctuation, etc.
            Category = ""
    End Select
End Function
Function RegExpFind(LookIn As String, PatternStr As String, Optional Pos, _
    Optional MatchCase As Boolean = True)
    
    
    ' This function uses Regular Expressions to parse a string (LookIn), and return matches to a
    ' pattern (PatternStr).  Use Pos to indicate which match you want:
    ' Pos omitted               : function returns a zero-based array of all matches
    ' Pos = 0                   : the last match
    ' Pos = 1                   : the first match
    ' Pos = 2                   : the second match
    ' Pos = <positive integer>  : the Nth match
    ' If Pos is greater than the number of matches, is negative, or is non-numeric, the function
    ' returns an empty string.  If no match is found, the function returns an empty string
    
    ' If MatchCase is omitted or True (default for RegExp) then the Pattern must match case (and
    ' thus you may have to use [a-zA-Z] instead of just [a-z] or [A-Z]).
    
    ' If you use this function in Excel, you can use range references for any of the arguments.
    ' If you use this in Excel and return the full array, make sure to set up the formula as an
    ' array formula.  If you need the array formula to go down a column, use TRANSPOSE()
    
    Dim RegX As Object
    Dim TheMatches As Object
    Dim Answer() As String
    Dim Counter As Long
    
    ' Evaluate Pos.  If it is there, it must be numeric and converted to Long
    If Not IsMissing(Pos) Then
        If Not IsNumeric(Pos) Then
            RegExpFind = ""
            Exit Function
        Else
            Pos = CLng(Pos)
        End If
    End If
    
    ' Create instance of RegExp object
    Set RegX = CreateObject("VBScript.RegExp")
    With RegX
        .Pattern = PatternStr
        .Global = True
        .IgnoreCase = Not MatchCase
    End With
        
    ' Test to see if there are any matches
    If RegX.test(LookIn) Then
        
        ' Run RegExp to get the matches, which are returned as a zero-based collection
        Set TheMatches = RegX.Execute(LookIn)
        
        ' If Pos is missing, user wants array of all matches.  Build it and assign it as the
        ' function's return value
        If IsMissing(Pos) Then
            ReDim Answer(0 To TheMatches.Count - 1) As String
            For Counter = 0 To UBound(Answer)
                Answer(Counter) = TheMatches(Counter)
            Next
            RegExpFind = Answer
        
        ' User wanted the Nth match (or last match, if Pos = 0).  Get the Nth value, if possible
        Else
            Select Case Pos
                Case 0                          ' Last match
                    RegExpFind = TheMatches(TheMatches.Count - 1)
                Case 1 To TheMatches.Count      ' Nth match
                    RegExpFind = TheMatches(Pos - 1)
                Case Else                       ' Invalid item number
                    RegExpFind = ""
            End Select
        End If
    
    ' If there are no matches, return empty string
    Else
        RegExpFind = ""
    End If
    
    ' Release object variables
    Set RegX = Nothing
    Set TheMatches = Nothing
    
End Function

Toggle HighlightingOpen in New WindowSelect All

Open in new window

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.