Function Color(rg As Range) As String
Const s8CharCodes = "NH623MUS;NH623MUS;"
Const s7CharCodes = "G502MUK;G502MUK;"
Const s6CharCodes = "NH537M;NH537M;NH575M;NH575M;NH526M;NH526M;NH503P;NH503P;NH561P;NH561P;NH605P;NH605P;YR512P;YR512P;NH592P;NH592P;NH611M;NH611M;NH617M;NH617M;YR525M;YR525M;YR523M;YR523M;NH624P;NH624P;NH636P;NH636P;NH658P;NH658P;YR532M;YR532M;YR528M;YR528M;NH642M;NH642M;NH675M;NH675M;YR551M;YR551M;NH684P;NH684P;YR535M;YR535M;NH701M;NH701M;YR559M;YR559M;NH614M;NH614M;NH623M;NH623M;NH583M;NH583M;NH567M;NH567M;YR565P;YR565P;YR552M;YR552M;NH726M;NH726M;NH674P;NH674P;NH691M;NH691M;YR550M;YR550M;NH711M;NH711M;YR571P;YR571P;YR566M;YR566M;YR562P;YR562P;NH636P;NH636P;NH624P;NH624P;YR563M;YR563M;NH731P;NH731P;NH737M;NH737M;NH736M;NH736M;NH743M;NH743M;NH750M;NH750M;NH700M;NH700M;YR578M;YR578M;NH761M;NH761M;NH757M;NH757M;NH766M;NH766M;NH756P;NH756P;NH756P;NH756P;YR574M;YR574M;YR576M;YR576M;YR571P;YR571P;NH701M;NH701M;NH773M;NH773M;YR559M;YR559M;YR580M;YR580M;NH782M;NH782M;NH731P;NH731P;NH788P;NH788P;NH788P;NH788P;YR593P;YR593P;NH573M;NH573M;NH789M;NH789M;"
Const s5CharCodes = "BG31P;BG31P;BG28P;BG28P;NH533;NH533;PB74P;PB74P;RP25P;RP25P;R505P;R505P;BG45M;BG45M;NH95M;NH95M;R504P;R504P;G503P;G503P;GY20M;GY20M;BG33P;BG33P;GY15P;GY15P;BG29P;BG29P;RP21M;RP21M;G506M;G506M;R516P;R516P;R517P;R517P;B512M;B512M;B502P;B502P;B507P;B507P;G513M;G513M;R522P;R522P;B509M;B509M;BG47P;BG47P;G511M;G511M;B522M;B522M;B529P;B529P;B528M;B528M;G520M;G520M;G516P;G516P;GY23M;GY23M;B531M;B531M;G517M;G517M;B536P;B536P;B538M;B538M;R500P;R500P;B506M;B506M;RP37P;RP37P;BG51M;BG51M;NH686;NH686;NH578;NH578;NH569;NH569;NH538;NH538;B532P;B532P;B537M;B537M;R525P;R525P;G526M;G526M;G524M;G524M;PB80M;PB80M;B553P;B553P;B548P;B548P;R532M;R532M;B520P;B520P;R530P;R530P;BG53M;BG53M;PB83P;PB83P;B549M;B549M;B558M;B558M;BG57P;BG57P;B536P;B536P;B568M;B568M;R543P;R543P;B572P;B572P;GY27M;GY27M;B564M;B564M;Y586P;Y586P;G535P;G535P;B584P;B584P;BG61M;BG61M;R539P;R539P;B570M;B570M;B581M;B581M;"
Const s4CharCodes = "B63P;B63P;G71P;G71P;R72P;R72P;B62P;B62P;B73M;B73M;G82P;G82P;R95P;R95P;B65M;B65M;G81P;G81P;R89P;R89P;G86P;G86P;R96P;R96P;B95P;B95P;G95P;G95P;B74P;B74P;R93P;R93P;B90P;B90P;B81M;B81M;Y61P;Y61P;G99P;G99P;R86P;R86P;Y62P;Y62P;Y57M;Y57M;Y66P;Y66P;B92P;B92P;B96P;B96P;B77P;B77P;R502;R502;R513;R513;Y66P;Y66P;Y585;Y585;Y69M;Y69M;Y70P;Y70P;B580;B580;"
Const s3CharCodes = "R81;R81;B94;B94;R90;R90;NH0;NH0;Y56;Y56;Y63;Y63;"
Dim sArray() As String, str As String, i As Long, j As Long
str = rg.Value
For j = 8 To 3 Step -1
If Len(str) > j Then
str = Left$(str, j)
Select Case j
Case Is = 8: sArray = Split(s3CharCodes, ";")
Case Is = 7: sArray = Split(s2CharCodes, ";")
Case Is = 6: sArray = Split(s1CharCodes, ";")
Case Is = 5: sArray = Split(s3CharCodes, ";")
Case Is = 4: sArray = Split(s2CharCodes, ";")
Case Is = 3: sArray = Split(s1CharCodes, ";")
End Select
For i = LBound(sArray) To UBound(sArray) Step 2
If str = sArray(i) Then
City = sArray(i + 1)
Exit Function
End If
Next i
End If
Next j
End Function
Bookmarks