Compare text, replace with number

[kokkentor]

I have two sheets
Sheet A-text contains text in columns Q, R, S, T, W
Sheet A-ID contains a number in column A and text in column B. (The number is the ID for the text.)

I want to search through columns Q, R, S, T and W in Sheet A-text.
If text similiar (like; not necessary identical) to text in column B in Sheet A-ID is found, then replace the text in Sheet A-text with the number corresponding to the text in Sheet A-ID (i.e. with the number in column A, Sheet A-ID)

Can anybody help me with a start?

Thanks!

 

[lozzablake]

what do you mean by similar. Contains/ starts with/ eg

if ID has xyz which of the following is a match?

abcxyz
xyzabc
axyzbc
abx y zc
xayz

 

[kokkentor]

Thanks for the reply, lozzablake!

By similar I mean starts with or contain. Probably contain. I think that is the best solution. The text I am searching through is very diverse and varied. It could be different kinds of expression for one and the same thing, i.e. "Goes to sleep", "Goes to bed", "Hits the sack", "Calls it a day" etc. - which I want to sort under one ID.

I thought it perhaps would be possible to define an expression that covers most of such expressions, say "bed" or "sleep", and thus do a rough sorting.

Anyway, if this is too much to ask, I am also interested in this kind of comparing /replacing in a simpler fashion.

 

[lozzablake]

OK this is what I would do and tell me it's OK before I start.

I would loop through each text in your ID sheet.
For each instance of text I would read in the ID number
I would then search for that text in each of columns Q,R,S,T,W and if I get a match I would replace it with the ID number

 

[kokkentor]

That it exactly my idea. I am just at loss when it comes to how to approach it in vba.

 

[lozzablake]

This should do it for you, but I have not tested it. Therefore be warned!

Sub ReplaceString()
    Dim rngUnique As Range   'range of strings on which to match
    Dim rngSearch As Range  'range to search
    Dim rngFound As Range   'range of matched string
    Dim i As Integer
    Dim strCode As String   'string to search for
    Dim Code                'code which replaces string
    Dim strFirstAddress As String  'address where first found
    
    'change for sheet names for your your range
    Set rngUnique = Sheets("sheet2").Range("a5:a15")   'change for your range
    Set rngSearch = Union(Sheets("sheet1").Columns("R:T"), Sheets("sheet1").Columns("Q:Q"), Sheets("sheet1").Columns("W:W"))
      
    'loop through the unique range to find matches
    For i = rngUnique.Row To rngUnique.Rows.Count + rngUnique.Row - 1
        strCode = rngUnique.Offset(i - rngUnique.Row, 0).Resize(1, 1).Value
        Code = rngUnique.Offset(i - rngUnique.Row, 1).Resize(1, 1).Value
        'now search for this code - note ignores case
        Set rngFound = rngSearch.Find(what:=strCode, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
        
        'check if found
        If Not rngFound Is Nothing Then
            rngFound = Code
            strFirstAddress = rngFound.Address
            'keep searching until return to original address
            Do
                Set rngFound = rngSearch.FindNext(rngFound)
                rngFound = Code
            Loop Until rngFound.Address = strFirstAddress
        End If
    Next i
End Sub

 

[kokkentor]

Thanks!

I modified the range to fit mine. (it is actually Column Q-W. I left U and V out in the first post). Is the range correctly specified?

However, I get an "Object variable or With block variable not set" message when running it. Debugging highlights the fifth last line (rngFound = Code).

Sub ReplaceString()
    Dim rngUnique As Range   'range of strings on which to match
    Dim rngSearch As Range  'range to search
    Dim rngFound As Range   'range of matched string
    Dim i As Integer
    Dim strCode As String   'string to search for
    Dim Code      'code which replaces string
    Dim strFirstAddress As String  'address where first found
    
    'change for sheet names for your your range
    Set rngUnique = Sheets("A-ID").Range("a2:a154")   'change for your range
    Set rngSearch = (Sheets("A-text").Columns("Q:W"))
    
    'loop through the unique range to find matches
    For i = rngUnique.Row To rngUnique.Rows.Count + rngUnique.Row - 1
        strCode = rngUnique.Offset(i - rngUnique.Row, 0).Resize(1, 1).Value
        Code = rngUnique.Offset(i - rngUnique.Row, 1).Resize(1, 1).Value
        'now search for this code - note ignores case
        Set rngFound = rngSearch.Find(what:=strCode, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
        
        'check if found
        If Not rngFound Is Nothing Then
            rngFound = Code
            strFirstAddress = rngFound.Address
            'keep searching until return to original address
            Do
                Set rngFound = rngSearch.FindNext(rngFound)
                rngFound = Code
            Loop Until rngFound.Address = strFirstAddress
        End If
    Next i
End Sub

 

[lozzablake]

should be

rngFound.Value

otherwise looks OK

 

[kokkentor]

I noticed some redundant brackets in the Set rngSearch I modified.
When removing the outer brackets, the code runs, but doesn't make any changes /replacements....

 

[lozzablake]

I had to make a slight change as we replace the original found text with a code and so you can error when you do FindNext. Here is the revised code which worked on my test data

Sub ReplaceString()
    Dim rngUnique As Range   'range of strings on which to match
    Dim rngSearch As Range  'range to search
    Dim rngFound As Range   'range of matched string
    Dim i As Integer
    Dim strCode As String   'string to search for
    Dim varCode                'code which replaces string
    Dim strFirstAddress As String  'address where first found
    
    'change for sheet names for your your range
    Set rngUnique = Sheets("A-ID").Range("a1:a6")   'change for your range
    Set rngSearch = Sheets("A-text").Columns("Q:W")
      
    'loop through the unique range to find matches
    For i = rngUnique.Row To rngUnique.Rows.Count + rngUnique.Row - 1
        strCode = rngUnique.Offset(i - rngUnique.Row, 0).Resize(1, 1).Value
        varCode = rngUnique.Offset(i - rngUnique.Row, 1).Resize(1, 1).Value
    
        Sheets("A-text").Activate
        'now search for this code - note ignores case, keep looping until not found as we replace the found text with ID
        Do
            Set rngFound = rngSearch.Find(what:=strCode, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
        
            'check if found
            If Not rngFound Is Nothing Then
                rngFound = varCode
    
            End If
        Loop Until rngFound Is Nothing
        
    Next i
End Sub