mprija
06-21-2006, 11:54 PM
Well I thought its sovled but I jut hit a wall again:banghead:. 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.
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
mvidas
06-22-2006, 06:16 AM
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: 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"[/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)
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
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.