Consulting

Results 1 to 12 of 12

Thread: Solved: Compare text strings in macro with strings in WS

  1. #1
    VBAX Regular
    Joined
    Apr 2006
    Posts
    22
    Location

    Solved: Compare text strings in macro with strings in WS

    I have a problem and I think it would be possible to solve it with macro. I have spreadsheet in which three letter text strings are separated in cells with (,). Whenever I get newer version of this same worksheet I need to manually check if there are some new text strings added to it. It is a big problem because worksheets are very big (about 600 rows). I would like to write macro in which I would define known text strings and when I would get new worksheet I would run macro on it, macro would compare strings defined in it with strings in workbook and new ones which would not be defined in macro would copy to new WS or display them in textbox. I just need sample code, which I will be able to extend myself. In attached file is small version of WS which I have. All three letter strings are in COLUMN A and in ROW 1, so macro does not need to check other cells. In example.xls file CDG, FCO, AMS, MXP, JFK, DCA and ORL are known strings and should be defined in macro. LGA and JFK are new strings and macro should found them and display them. If anyone can help me I would be grateful.

  2. #2
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location
    Hi there,

    I've just mocked up a quick piece for you on how to split the strings apart and paste them to a worksheet. I'll let you decide what to do with it, but the easiest may be:
    -Let it paste to a temporary worksheet
    -Add a vlookup in the next column to see if it returns an N/A value
    -Check the table and add any with N/A values to your master list
    -Clear the temporary sheet and move to the next row

    Now, I am not saying that this would be the most efficient, as looping is slow, but it might be the easiest to code. You could always try and go an alternate route, reading all your master list into an array and doing a vlookup based on that. I've never tried it, but it might work.

    Here's the code:
    Sub SplitAndTranspose()
        Dim strTemp As String
        Dim myarray() As String
    
        strTemp = "CDG, FCO, AMS, MXP, JFK, DCA" 'update with the string you want to split
        myarray = Split(strTemp, ",")
        ActiveSheet.Range("A1").Resize(UBound(myarray), 1) = WorksheetFunction.Transpose(myarray)
    End Sub
    Last edited by Aussiebear; 03-22-2023 at 10:01 PM. Reason: Adjusted the code tags
    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  3. #3
    Knowledge Base Approver
    The King of Overkill!
    VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    Hi mprija,

    Sub CheckCodes()
     Dim CurCodes() As String, NewCodes() As String, Cnt As Long
     Dim tempStr As String, AllArr(), R As Long, C As Long
     Dim RegEx As Object, RegC As Object, RegM As Object
    'Existing codes:
     tempStr = "CDG, FCO, AMS, MXP, JFK, DCA, ORL"
    ReDim NewCodes(0)
     Cnt = 0
     CurCodes = Split(Replace(tempStr, " ", ""), ",")
    Set RegEx = CreateObject("vbscript.regexp")
     With RegEx
       .IgnoreCase = True
       .Global = True
       .Pattern = "\b[a-z]{3}\b"
     End With
    AllArr = ActiveSheet.UsedRange.Value
     For C = 1 To UBound(AllArr, 2)
       For R = 1 To UBound(AllArr, 1)
          If RegEx.Test(AllArr(R, C)) Then
            Set RegC = RegEx.Execute(AllArr(R, C))
               For Each RegM In RegC
                  If Not InStrArray(RegM, NewCodes) Then
                      ReDim Preserve NewCodes(Cnt)
                      NewCodes(Cnt) = RegM
                      Cnt = Cnt + 1
                  End If
              Next
          End If
       Next
     Next
    tempStr = ""
     For i = 0 To Cnt - 1
       If Not InStrArray(NewCodes(i), CurCodes) Then
          tempStr = tempStr & IIf(Len(tempStr) = 0, "", ", ") & NewCodes(i)
       End If
     Next
     If Len(tempStr) > 0 Then MsgBox "New codes: " & vbCrLf & tempStr
       Set RegEx = Nothing
       Set RegM = Nothing
       Set RegC = Nothing
    End Sub
    
    Function InStrArray(ByVal vValue As String, ByRef vArray() As String) As Boolean
     Dim i As Long
     For i = 0 To UBound(vArray)
       If LCase(vArray(i)) = LCase(vValue) Then
          InStrArray = True
          Exit Function
       End If
     Next
    End Function
    Matt
    Last edited by Aussiebear; 03-22-2023 at 10:06 PM. Reason: Adjusted code tags

  4. #4
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location
    Nice Matt!

    One day I'm going to have to learn that RegEx thing.
    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  5. #5
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location

    Array Transfers + RegExp = Fun stuff
    I thought about adding in a dictionary object for Dave's sake, as it would have worked equally well and he loves RegExp+Dictionaries, but decided to stick with just a regular array.

  6. #6
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location
    So here's a question... is it faster to go the RegExp route than say...

    -Reading the master list into one array
    -Reading the data into another array
    -Checking to see if data element from array 2 exists in array 1 by another means?

    Just curious...
    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  7. #7
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    Sure, you could do it that way without regexp. First you need to write something that will know to take CDG and LJU out of "CDG, LJU" and similarly take JFK and LGA out of "JFK/LGA". But you would also have to make sure it doesnt take ABC and BCD out of "ABCD". I'm going to try and write a function right now to do that, which I'm 99% sure would be much slower than regexp. But it sure sounds interesting to write. brb

  8. #8
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    ok, give this a whirl:
    Sub TrialUsage()
     Dim tStr As String, tArr() As String, i As Long
    tStr = "CDG, LJU"
     tArr = Get3CharStrings(tStr)
     If Len(tArr(0)) > 0 Then
       MsgBox "'" & tStr & "' contains " & UBound(tArr) + 1 & " airports:" & _
       vbCrLf & Join(tArr, vbCrLf)
       Else
       MsgBox "'" & tStr & "' contains 0 airports."
     End If
    tStr = "JFK/LGA"
     tArr = Get3CharStrings(tStr)
     If Len(tArr(0)) > 0 Then
       MsgBox "'" & tStr & "' contains " & UBound(tArr) + 1 & " airports:" & _
       vbCrLf & Join(tArr, vbCrLf)
       Else
       MsgBox "'" & tStr & "' contains 0 airports."
     End If
    tStr = "ABCD"
     tArr = Get3CharStrings(tStr)
     If Len(tArr(0)) > 0 Then
       MsgBox "'" & tStr & "' contains " & UBound(tArr) + 1 & " airports:" & _
       vbCrLf & Join(tArr, vbCrLf)
       Else
       MsgBox "'" & tStr & "' contains 0 airports."
     End If
    tStr = "CDG, ABCD/LJU"
     tArr = Get3CharStrings(tStr)
     If Len(tArr(0)) > 0 Then
       MsgBox "'" & tStr & "' contains " & UBound(tArr) + 1 & " airports:" & _
       vbCrLf & Join(tArr, vbCrLf)
       Else
       MsgBox "'" & tStr & "' contains 0 airports."
     End If
    End Sub
    
    Function Get3CharStrings(ByVal vStr As String) As String()
     Dim tempArr() As String, i As Long, arrCnt As Long, StrMtch As Boolean
     arrCnt = 0
     ReDim tempArr(arrCnt)
     vStr = UCase(vStr) 'so we only have to check for capital letters
     For i = 1 To Len(vStr) - 2
      If Mid(vStr, i, 1) Like "[A-Z]" And Mid(vStr, i + 1, 1) Like "[A-Z]" _
    And Mid(vStr, i + 2, 1) Like "[A-Z]" Then
       strMatch = True
       If i > 1 Then
           If Mid(vStr, i - 1, 1) Like "[A-Z]" Then strMatch = False
       End If
       If i < Len(vStr) - 2 Then
           If Mid(vStr, i + 3, 1) Like "[A-Z]" Then strMatch = False
       End If
       If strMatch Then
           ReDim Preserve tempArr(arrCnt)
           tempArr(arrCnt) = Mid(vStr, i, 3)
           arrCnt = arrCnt + 1
       End If
      End If
     Next
     Get3CharStrings = tempArr
    End Function
    Matt
    Last edited by Aussiebear; 03-22-2023 at 10:10 PM. Reason: Adjusted code tags

  9. #9
    VBAX Regular
    Joined
    Apr 2006
    Posts
    22
    Location
    Thank you Matt and Ken, you both helped me a lot, my big problem is solved, thank you again.

  10. #10
    VBAX Regular
    Joined
    Apr 2006
    Posts
    22
    Location
    Well I thought its sovled but I jut hit a wall again. Matt your code works for me, but there is a problem that my tempStr line is too long, there are too many 3 lettter codes separated with with (,), so VBA compiler breaks it into two lines and then I am getting Compile Error: Syntax Error. Maybe somebody can help me how to split that line in a way that macro would work? In code bellow I have coloured all 3 letter codes which does not fit in right line.

    [Codes]Sub CheckCodes()
    Dim CurCodes() As String, NewCodes() As String, Cnt As Long
    Dim tempStr As String, AllArr(), R As Long, C As Long
    Dim RegEx As Object, RegC As Object, RegM As Object
    'Existing codes:
    tempStr = "AAL, AAR, BLL, KRP, RNN, SGD, ABV, NBO, PHC, ABZ, BFS, BHX, EDI, GLA, LBA,
    MME, NCL, ACC, AES, HAU, KSU, MOL, TRD, AGB, BER, BRE, CGN, DRS, DTM, DUS, FDH, FMO,
    GWT, HAJ, HAM, HDB, HDF, HOQ, LEJ, MHG, NUE, PAD, SCN, STR, AGP, ALC, BIO, IBZ, LCG,
    LPA, OVD, PMI, SCQ, SVQ, TFS, TFN, VGO, VLC, AHO, BDS, BRI, CAG, CRV, CTA, PMO, PSR,
    REG, SUF, VRN, AJR, JKG, KLR, KSD, LLA, LPI, NRK, ORB, OSD, RNB, SDL, UME, VST, VXO, ALA,
    ALF, BOO, FAE, KKN, KRN, LYR, TOS, ALG, AYT, CMN, ADB, MSQ, TUN, ALP, AUH, BAH, DOH,
    DMM, JED, KWI, MCT, RUH, SAH, AMM, AMS, AOI, BLQ, FLR, GOA, NAP, OLB, PSA, TRN, TRS,
    VCE, ARN, ASB, TAS, ASM, FIH, ATH, BCN, BEG, BEY, BFN, CPT, DUR, ELS, GRJ, KIM, NLP, PLZ,
    BGO, BJL, DAR, DLA, FNA, JRO, SSG, YAO, BRN, BSL, GVA, LUG, LUX, BRU, BTS, GRZ, INN, KLU,
    LNZ, SZG, BUD, CAI, CDG, CKY, HRE, KGL, LAD, LLW, LUN, MLW, WDH, VFA, CLJ, KSC, IAS,
    SBZ, TSR, CPH, DAM, DBV, PUY, SPU, ZAD, DNK, HRK, KIV, DOK, GOJ, KRR, KUF, KZN, UFA,
    PEE, ROV, SVX, DUB, DXB, ESB, AXD, CFU, CHQ, HER, IOA, JKH, JMK"
    JTR, KGS, KVA, LCA, MJT, MLA, RHO, EVN, FAO, OPO, FCO, FRA, GDN, KRK, KTW, POZ, SZZ,
    WRO, GOT, GYD, GYD, HBE, HEL, ISB, LHE, IST, JNB, KBP, KHI, KRS, SVG, KRT, KTM, KUO, OUL,
    RVN, TKU, TMP, VAA, LED, LHR, LIS, LJU, OHD, TBS, LOS, LWO, ODS, MAD, MAN, MUC, MXP,
    NCE, ORK, SNN, OSL, OSR, PEV, OTP, PLQ, RIX, TLL, PRG, PRN, QJZ, QXG, XER, XDB, XOP,
    XSH, XYL, XZN, ZFJ, ZFQ, ZLN, SJJ, SKG, SKP, SOF, SVO, TGD, TIA, TIP, TLV, TSE, VAR, VIE,
    VNO, WAW, ZAG, ZFQ, LYS, MRS, TLS, ZRH"
    ReDim NewCodes(0)
    Cnt = 0
    CurCodes = Split(Replace(tempStr, " ", ""), ",")
    Set RegEx = CreateObject("vbscript.regexp")
    With RegEx
    .IgnoreCase = True
    .Global = True
    .Pattern = "\b[a-z]{3}\b"
    End With
    AllArr = ActiveSheet.UsedRange.Value
    For C = 1 To UBound(AllArr, 2)
    For R = 1 To UBound(AllArr, 1)
    If RegEx.Test(AllArr(R, C)) Then
    Set RegC = RegEx.Execute(AllArr(R, C))
    For Each RegM In RegC
    If Not InStrArray(RegM, NewCodes) Then
    ReDim Preserve NewCodes(Cnt)
    NewCodes(Cnt) = RegM
    Cnt = Cnt + 1
    End If
    Next
    End If
    Next
    Next

    tempStr = ""
    For i = 0 To Cnt - 1
    If Not InStrArray(NewCodes(i), CurCodes) Then
    tempStr = tempStr & IIf(Len(tempStr) = 0, "", ", ") & NewCodes(i)
    End If
    Next
    If Len(tempStr) > 0 Then MsgBox "New codes: " & vbCrLf & tempStr
    Set RegEx = Nothing
    Set RegM = Nothing
    Set RegC = Nothing
    End Sub

    Function InStrArray(ByVal vValue As String, ByRef vArray() As String) As Boolean
    Dim i As Long
    For i = 0 To UBound(vArray)
    If LCase(vArray(i)) = LCase(vValue) Then
    InStrArray = True
    Exit Function[/Code]
    Last edited by Aussiebear; 03-22-2023 at 10:14 PM. Reason: Adjusted the code tags

  11. #11
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    Hi again,

    I edited your code above so the screen wouldnt span far to the right, I understand what you're saying though about too much in that tempStr variable (296 codes!)

    You can always use the line continuation character of _ like:
        tempStr = "AAL, AAR, BLL, KRP, RNN, SGD, ABV, NBO, PHC, ABZ, BFS, BHX, EDI, GLA, LBA, " & _
        "MME, NCL, ACC, AES, HAU, KSU, MOL, TRD, AGB, BER, BRE, CGN, DRS, DTM, DUS, FDH, FMO, " & _
        "GWT, HAJ, HAM, HDB, HDF, HOQ, LEJ, MHG, NUE, PAD, SCN, STR, AGP, ALC, BIO, IBZ, LCG, " & _
        "LPA, OVD, PMI, SCQ, SVQ, TFS, TFN, VGO, VLC, AHO, BDS, BRI, CAG, CRV, CTA, PMO, PSR, " & _
        "REG, SUF, VRN, AJR, JKG, KLR, KSD, LLA, LPI, NRK, ORB, OSD, RNB, SDL, UME, VST, VXO, " & _
        "ALA, ALF, BOO, FAE, KKN, KRN, LYR, TOS, ALG, AYT, CMN, ADB, MSQ, TUN, ALP, AUH, BAH, " & _
        "DOH, DMM, JED, KWI, MCT, RUH, SAH, AMM, AMS, AOI, BLQ, FLR, GOA, NAP, OLB, PSA, TRN, " & _
        "TRS, VCE, ARN, ASB, TAS, ASM, FIH, ATH, BCN, BEG, BEY, BFN, CPT, DUR, ELS, GRJ, KIM, " & _
        "NLP, PLZ, BGO, BJL, DAR, DLA, FNA, JRO, SSG, YAO, BRN, BSL, GVA, LUG, LUX, BRU, BTS, " & _
        "GRZ, INN, KLU, LNZ, SZG, BUD, CAI, CDG, CKY, HRE, KGL, LAD, LLW, LUN, MLW, WDH, VFA, " & _
        "CLJ, KSC, IAS, SBZ, TSR, CPH, DAM, DBV, PUY, SPU, ZAD, DNK, HRK, KIV, DOK, GOJ, KRR, " & _
        "KUF, KZN, UFA, PEE, ROV, SVX, DUB, DXB, ESB, AXD, CFU, CHQ, HER, IOA, JKH, JMK, JTR, " & _
        "KGS, KVA, LCA, MJT, MLA, RHO, EVN, FAO, OPO, FCO, FRA, GDN, KRK, KTW, POZ, SZZ, WRO, " & _
        "GOT, GYD, GYD, HBE, HEL, ISB, LHE, IST, JNB, KBP, KHI, KRS, SVG, KRT, KTM, KUO, OUL, " & _
        "RVN, TKU, TMP, VAA, LED, LHR, LIS, LJU, OHD, TBS, LOS, LWO, ODS, MAD, MAN, MUC, MXP, " & _
        "NCE, ORK, SNN, OSL, OSR, PEV, OTP, PLQ, RIX, TLL, PRG, PRN, QJZ, QXG, XER, XDB, XOP, " & _
        "XSH, XYL, XZN, ZFJ, ZFQ, ZLN, SJJ, SKG, SKP, SOF, SVO, TGD, TIA, TIP, TLV, TSE, VAR, " & _
        "VIE, VNO, WAW, ZAG, ZFQ, LYS, MRS, TLS, ZRH"
    Since the code I'm using removes spaces anyways from that, you could save some room (since you can only use so many line continuation characters) by removing them:[vba] tempStr = "AAL,AAR,ABV,ABZ,ACC,ADB,AES,AGB,AGP,AHO,AJR,ALA,ALC,ALF,ALG,ALP,AMM,AM S," & _
    "AOI,ARN,ASB,ASM,ATH,AUH,AXD,AYT,BAH,BCN,BDS,BEG,BER,BEY,BFN,BFS,BGO,BHX,BI O,BJL," & _
    "BLL,BLQ,BOO,BRE,BRI,BRN,BRU,BSL,BTS,BUD,CAG,CAI,CDG,CFU,CGN,CHQ,CKY,CLJ,CM N,CPH," & _
    "CPT,CRV,CTA,DAM,DAR,DBV,DLA,DMM,DNK,DOH,DOK,DRS,DTM,DUB,DUR,DUS,DXB,EDI,EL S,ESB," & _
    "EVN,FAE,FAO,FCO,FDH,FIH,FLR,FMO,FNA,FRA,GDN,GLA,GOA,GOJ,GOT,GRJ,GRZ,GVA,GW T,GYD," & _
    "GYD,HAJ,HAM,HAU,HBE,HDB,HDF,HEL,HER,HOQ,HRE,HRK,IAS,IBZ,INN,IOA,ISB,IST,JE D,JKG," & _
    "JKH,JMK,JNB,JRO,JTR,KBP,KGL,KGS,KHI,KIM,KIV,KKN,KLR,KLU,KRK,KRN,KRP,KRR,KR S,KRT," & _
    "KSC,KSD,KSU,KTM,KTW,KUF,KUO,KVA,KWI,KZN,LAD,LBA,LCA,LCG,LED,LEJ,LHE,LHR,LI S,LJU," & _
    "LLA,LLW,LNZ,LOS,LPA,LPI,LUG,LUN,LUX,LWO,LYR,LYS,MAD,MAN,MCT,MHG,MJT,MLA,ML W,MME," & _
    "MOL,MRS,MSQ,MUC,MXP,NAP,NBO,NCE,NCL,NLP,NRK,NUE,ODS,OHD,OLB,OPO,ORB,ORK,OS D,OSL," & _
    "OSR,OTP,OUL,OVD,PAD,PEE,PEV,PHC,PLQ,PLZ,PMI,PMO,POZ,PRG,PRN,PSA,PSR,PUY,QJ Z,QXG," & _
    "REG,RHO,RIX,RNB,RNN,ROV,RUH,RVN,SAH,SBZ,SCN,SCQ,SDL,SGD,SJJ,SKG,SKP,SNN,SO F,SPU," & _
    "SSG,STR,SUF,SVG,SVO,SVQ,SVX,SZG,SZZ,TAS,TBS,TFN,TFS,TGD,TIA,TIP,TKU,TLL,TL S,TLV," & _
    "TMP,TOS,TRD,TRN,TRS,TSE,TSR,TUN,UFA,UME,VAA,VAR,VCE,VFA,VGO,VIE,VLC,VNO,VR N,VST," & _
    "VXO,WAW,WDH,WRO,XDB,XER,XOP,XSH,XYL,XZN,YAO,ZAD,ZAG,ZFJ,ZFQ,ZFQ,ZLN,ZR H"[/Code]


    In all honesty, I would recommend keeping a worksheet to store these, and have it hidden or something. I can update the code above to automatically add them to the list if you'd like. You can create the sheet with codes by running this one time:
    Sub CreateAirportCodesSheet()
        Dim tempStr As String, tempArr() As String
        tempStr = "AAL,AAR,ABV,ABZ,ACC,ADB,AES,AGB,AGP,AHO,AJR,ALA,ALC,ALF,ALG,ALP,AMM,AMS," & _
        "AOI,ARN,ASB,ASM,ATH,AUH,AXD,AYT,BAH,BCN,BDS,BEG,BER,BEY,BFN,BFS,BGO,BHX,BIO,BJL," & _
        "BLL,BLQ,BOO,BRE,BRI,BRN,BRU,BSL,BTS,BUD,CAG,CAI,CDG,CFU,CGN,CHQ,CKY,CLJ,CMN,CPH," & _
        "CPT,CRV,CTA,DAM,DAR,DBV,DLA,DMM,DNK,DOH,DOK,DRS,DTM,DUB,DUR,DUS,DXB,EDI,ELS,ESB," & _
        "EVN,FAE,FAO,FCO,FDH,FIH,FLR,FMO,FNA,FRA,GDN,GLA,GOA,GOJ,GOT,GRJ,GRZ,GVA,GWT,GYD," & _
        "GYD,HAJ,HAM,HAU,HBE,HDB,HDF,HEL,HER,HOQ,HRE,HRK,IAS,IBZ,INN,IOA,ISB,IST,JED,JKG," & _
        "JKH,JMK,JNB,JRO,JTR,KBP,KGL,KGS,KHI,KIM,KIV,KKN,KLR,KLU,KRK,KRN,KRP,KRR,KRS,KRT," & _
        "KSC,KSD,KSU,KTM,KTW,KUF,KUO,KVA,KWI,KZN,LAD,LBA,LCA,LCG,LED,LEJ,LHE,LHR,LIS,LJU," & _
        "LLA,LLW,LNZ,LOS,LPA,LPI,LUG,LUN,LUX,LWO,LYR,LYS,MAD,MAN,MCT,MHG,MJT,MLA,MLW,MME," & _
        "MOL,MRS,MSQ,MUC,MXP,NAP,NBO,NCE,NCL,NLP,NRK,NUE,ODS,OHD,OLB,OPO,ORB,ORK,OSD,OSL," & _
        "OSR,OTP,OUL,OVD,PAD,PEE,PEV,PHC,PLQ,PLZ,PMI,PMO,POZ,PRG,PRN,PSA,PSR,PUY,QJZ,QXG," & _
        "REG,RHO,RIX,RNB,RNN,ROV,RUH,RVN,SAH,SBZ,SCN,SCQ,SDL,SGD,SJJ,SKG,SKP,SNN,SOF,SPU," & _
        "SSG,STR,SUF,SVG,SVO,SVQ,SVX,SZG,SZZ,TAS,TBS,TFN,TFS,TGD,TIA,TIP,TKU,TLL,TLS,TLV," & _
        "TMP,TOS,TRD,TRN,TRS,TSE,TSR,TUN,UFA,UME,VAA,VAR,VCE,VFA,VGO,VIE,VLC,VNO,VRN,VST," & _
        "VXO,WAW,WDH,WRO,XDB,XER,XOP,XSH,XYL,XZN,YAO,ZAD,ZAG,ZFJ,ZFQ,ZFQ,ZLN,ZRH"
        tempArr = Split(tempStr, ",")
        With Sheets.Add
       .Range("A1").Resize(UBound(tempArr) + 1, 1).Value = Application.Transpose(tempArr)
       .Name = "Airport Codes"
       .Visible = xlSheetVeryHidden
        End With
    End Sub
    Then you can update the code I gave you yesterday to:
    Sub CheckCodes()
        Dim CurCodes() As String, NewCodes() As String, Cnt As Long
        Dim tempArr() As Variant, AllArr(), R As Long, C As Long
        Dim RegEx As Object, RegC As Object, RegM As Object, tempStr As String
    'Existing codes:
        With Sheets("Airport Codes")
       tempArr = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value
        End With
        ReDim CurCodes(UBound(tempArr) - 1)
        For Cnt = 1 To UBound(tempArr, 1)
       CurCodes(Cnt - 1) = CStr(tempArr(Cnt, 1))
        Next
    ReDim NewCodes(0)
        Cnt = 0
    Set RegEx = CreateObject("vbscript.regexp")
        With RegEx
       .IgnoreCase = True
       .Global = True
       .Pattern = "\b[a-z]{3}\b"
        End With
    AllArr = ActiveSheet.UsedRange.Value
        For C = 1 To UBound(AllArr, 2)
        For R = 1 To UBound(AllArr, 1)
           If RegEx.Test(AllArr(R, C)) Then
              Set RegC = RegEx.Execute(AllArr(R, C))
              For Each RegM In RegC
                  If Not InStrArray(RegM, NewCodes) Then
                     ReDim Preserve NewCodes(Cnt)
                     NewCodes(Cnt) = RegM
                     Cnt = Cnt + 1
                  End If
              Next
          End If
       Next
        Next
         
        tempStr = ""
        For R = 0 To Cnt - 1
       If Not InStrArray(NewCodes(R), CurCodes) Then
          Sheets("Airport Codes").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = NewCodes®
             tempStr = tempStr & IIf(Len(tempStr) = 0, "", ", ") & NewCodes®
        End If
        Next
        If Len(tempStr) > 0 Then MsgBox "New codes: " & vbCrLf & tempStr
       Set RegEx = Nothing
       Set RegM = Nothing
       Set RegC = Nothing
    End Sub
    
    Function InStrArray(ByVal vValue As String, ByRef vArray() As String) As Boolean
        Dim i As Long
        For i = 0 To UBound(vArray)
       If LCase(vArray(i)) = LCase(vValue) Then
          InStrArray = True
          Exit Function
       End If
        Next
    End Function
    Which will utilize the VeryHidden sheet Airport Codes and store them there. I included a line to add the airport codes automatically to the sheet as well when new ones are detected, but it will still notify you of them. If you don't want that, then comment out or remove the following line:[vba] Sheets("Airport Codes").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = NewCodes(R)[/vba]

    Also, you don't need to PM me when you post a followup reply, I check the site frequently enough and re-visit all threads I've participated in, plus I get the emails notifying me of new posts.

    Matt
    Last edited by Aussiebear; 03-22-2023 at 10:21 PM. Reason: Adjusted the code tags

  12. #12
    VBAX Regular
    Joined
    Apr 2006
    Posts
    22
    Location
    Thank you Matt, and sorry PM, you helped me a lot and solved big problem for me.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •