FIND method with LIKE operator

[bendy_leather2]

Excel - Office 365

Hi all,

I was hoping you kind Excel folks may be able to help me out. I am trying to find acronyms within a workbook (based on the formatting of 1 or more uppercase letters, followed by 1 lowercase letter, followed by 1 or more uppercase letters.)

My question is... Is it possible to combine the LIKE operator with the FIND method? My initial idea was to utilise the FIND method to locate the acronyms and then list them on another sheet, I cant get this to work unless i specify the string itself rather than its format.

Failing that, does anyone know of a way (or throw me in the right direction) to go about searching for acronyms within a workbook?

Thanks in advance!

 

[Peter_SSs]

Could we have a small set of sample data so that we can see both your layout and the sort of variety of data you are dealing with? Best if you can use XL2BB and also include the expected results.

 

[bendy_leather2]

Thanks for the reply, much appreciated.
After looking further I have used RegEx to get what i wanted. I wrote code to loop through ranges and then get the regex results and paste them out. Is it worth my code being posted, given it has nothing to do with LIKE being used with FIND?

 

[Peter_SSs]

Is it worth my code being posted

Yes.
- It could be helpful to others searching the forum.
- I had envisaged a RegExp solution too, so I would be interested to compare your code to what I had in mind.

 

[bendy_leather2]

I ended up using 3 routines.
1. ListAcronyms - loops through ranges in each sheet
2. RegExExtract - writes all instances of the string to a variant
3. PasteResults - loops through the RegExExtract variant and pastes unique results to a new workbook

Please dont be too harsh with my programming, I'm sure there is a much better way of doing this.

 

[bendy_leather2]

It looks like i messed up when posting the code... ill try again

Sub ListAcronyms()
Dim Rng As Range
Dim Sht As Worksheet
Dim RegEx As Object, Matches As Object
Dim REPattern As String
Dim Cntr As Integer
Dim Wkb As Workbook

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Set RegEx = CreateObject("vbscript.regexp")
REPattern = "([A-Z]{1,}[a-z][A-Z]{1,})|([A-Z]{2,})|([a-z][A-Z]{1,})"

Set Wkb = Workbooks.Add
With Wkb.Sheets(1)
    .Range("A1").Value = "ACRONYM"
    .Range("B1").Value = "COUNT"
    .Range("C1").Value = "FIRST APPEARS ON"
End With

For Each Sht In ThisWorkbook.Sheets
    For Each Rng In Sht.UsedRange
        Set Matches = Nothing
        
        On Error Resume Next
        Set Matches = RegExExtract(Rng.Value, REPattern)
        On Error GoTo 0
        
        If Not Matches Is Nothing Then
            Call PasteResults(Wkb, Matches, Sht.Name)
        End If
    Next Rng
Next Sht

Wkb.Sheets(1).Columns("A:C").AutoFit

MsgBox "done!"

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[bendy_leather2]

Public Function RegExExtract(Str As String, Pattern As String) As Variant
    Dim Matches As Object
    Dim RegEx As Object
    Set RegEx = CreateObject("vbscript.regexp")
    RegEx.Pattern = Pattern
    ' Must be True to find all matches
    RegEx.Global = True
    If RegEx.Test(Str) Then
        Set RegExExtract = RegEx.Execute(Str)
    End If
    If IsEmpty(RegExExtract) Then
        RegExExtract = 0
    End If
    Set RegEx = Nothing
End Function

 

[bendy_leather2]

Public Sub PasteResults(ByRef WrkB As Workbook, ByRef Reslts As Object, ShtName As String)
Dim Cntr As Integer
Dim cntStr As Integer, cntMatch As Integer

With WrkB.Sheets(1)
    For Cntr = 0 To Reslts.Count - 1
        cntMatch = 0
        On Error Resume Next
        cntMatch = WorksheetFunction.Match(Reslts(Cntr), .Range("A:A"), 0)
        On Error GoTo 0
        
        cntStr = WorksheetFunction.CountA(.Range("A:A"))
        With .Range("A1")
            If cntMatch = 0 Then
                .Offset(cntStr, 0).Value = Reslts(Cntr)
                .Offset(cntStr, 1).Value = 1
                .Offset(cntStr, 2).Value = ShtName
            Else
                .Offset(cntMatch - 1, 1).Value = .Offset(cntMatch - 1, 1).Value + 1
            End If
        End With
    Next Cntr
End With

End Sub

 

[bendy_leather2]

Ignore the line of code
Set RegEx = CreateObject("vbscript.regexp")
in the ListAcronyms routine, it doesn't need to be there. Nor does the variable RegEx.

 

[Peter_SSs]

Thanks for sharing the codes. I certainly don't see anything particularly wrong with them. There is no particular value in either of the following suggestions but

- I think (not highly tested) that you could write your RegExp pattern a little shorter as follows

REPattern = "([A-Z]{1,}[a-z][A-Z]{1,})|([A-Z]{2,})|([a-z][A-Z]{1,})"
REPattern = "(([A-Z]+[a-z]?)|([a-z]))[A-Z]+"

- There is a shortening you could also do here

With Wkb.Sheets(1)
    .Range("A1").Value = "ACRONYM"
    .Range("B1").Value = "COUNT"
    .Range("C1").Value = "FIRST APPEARS ON"
End With

Wkb.Sheets(1).Range("A1:C1").Value = Array("ACRONYM", "COUNT", "FIRST APPEARS ON")