[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit
[/COLOR]
[COLOR=darkblue]Sub[/COLOR] RetrieveWorkNumbers()
[COLOR=darkblue]Dim[/COLOR] dicSiteCodes [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
[COLOR=darkblue]Dim[/COLOR] dicResults [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
[COLOR=darkblue]Dim[/COLOR] varSiteCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
[COLOR=darkblue]Dim[/COLOR] rngFoundCell [COLOR=darkblue]As[/COLOR] Range
[COLOR=darkblue]Dim[/COLOR] strFirstAddress [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
[COLOR=darkblue]Dim[/COLOR] strLookupString [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
[COLOR=darkblue]Dim[/COLOR] strSiteCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
[COLOR=darkblue]Dim[/COLOR] strWorkNumber [COLOR=darkblue]As[/COLOR] String
[COLOR=darkblue]Dim[/COLOR] varEndDate [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
[COLOR=darkblue]Dim[/COLOR] TotalSubStrings [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Double[/COLOR]
[COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
[COLOR=darkblue]Const[/COLOR] SubStringLength [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR] = 4
[COLOR=darkblue]If[/COLOR] ActiveSheet [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
[COLOR=darkblue]If[/COLOR] ActiveSheet.Name <> "PT 4" [COLOR=darkblue]Then[/COLOR]
MsgBox "Make sure that the correct worksheet is the active sheet!", vbExclamation
[COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
[COLOR=darkblue]If[/COLOR] UCase(Cells(1, ActiveCell.Column)) <> "SITE CODE" [COLOR=darkblue]Then[/COLOR]
MsgBox "Make sure that a cell within the correct column is selected!", vbExclamation
[COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
strLookupString = Trim(ActiveCell.Value)
strLookupString = Application.WorksheetFunction.Clean(strLookupString)
[COLOR=darkblue]If[/COLOR] Len(strLookupString) = 0 [COLOR=darkblue]Then[/COLOR]
MsgBox "The selected cell is empty!", vbExclamation
[COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
TotalSubStrings = Len(strLookupString) / SubStringLength
[COLOR=darkblue]If[/COLOR] Int(TotalSubStrings) <> [COLOR=darkblue]To[/COLOR]tal[COLOR=darkblue]Sub[/COLOR]Strings [COLOR=darkblue]Then[/COLOR]
MsgBox "Make sure the active cell constains the correct string...", vbExclamation
[COLOR=darkblue]Exit[/COLOR] Sub
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
[COLOR=darkblue]Set[/COLOR] dicSiteCodes = CreateObject("Scripting.Dictionary")
dicSiteCodes.CompareMode = 1 [COLOR=green]'vbTextCompare[/COLOR]
[COLOR=darkblue]For[/COLOR] i = 1 To TotalSubStrings
strSiteCode = Mid(strLookupString, i * SubStringLength - [COLOR=darkblue]Sub[/COLOR]StringLength + 1, SubStringLength)
[COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] dicSiteCodes.Exists(strSiteCode) [COLOR=darkblue]Then[/COLOR]
dicSiteCodes.Add strSiteCode, strSiteCode
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
[COLOR=darkblue]Next[/COLOR] i
[COLOR=darkblue]Set[/COLOR] dicResults = CreateObject("Scripting.Dictionary")
dicResults.CompareMode = 1 [COLOR=green]'vbTextCompare[/COLOR]
[COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] varSiteCode [COLOR=darkblue]In[/COLOR] dicSiteCodes.Keys
[COLOR=darkblue]With[/COLOR] Worksheets("SM9 Export").Columns("C")
[COLOR=darkblue]Set[/COLOR] rngFoundCell = .Find(what:=varSiteCode, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
[COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] rngFoundCell [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
strFirstAddress = rngFoundCell.Address
[COLOR=darkblue]Do[/COLOR]
strWorkNumber = rngFoundCell.Offset(, -2).Value
[COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] dicResults.Exists(strWorkNumber) [COLOR=darkblue]Then[/COLOR]
varEndDate = rngFoundCell.Offset(, -1).Value
[COLOR=darkblue]If[/COLOR] IsDate(varEndDate) [COLOR=darkblue]Then[/COLOR]
varEndDate = [COLOR=darkblue]CDate[/COLOR](varEndDate)
End [COLOR=darkblue]If[/COLOR]
dicResults.Add strWorkNumber, var[COLOR=darkblue]End[/COLOR]Date
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
[COLOR=darkblue]Set[/COLOR] rngFoundCell = .FindNext(rngFoundCell)
[COLOR=darkblue]Loop[/COLOR] [COLOR=darkblue]While[/COLOR] rngFoundCell.Address <> strFirstAddress
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]Next[/COLOR] varSiteCode
ActiveCell.Offset(, 1).EntireColumn.Resize(Rows.Count - 1, 2).Offset(1, 0).ClearContents
[COLOR=darkblue]If[/COLOR] dicResults.Count > 0 [COLOR=darkblue]Then[/COLOR]
ActiveCell.Offset(, 1).Resize(dicResults.Count).Value = Application.Transpose(dicResults.Keys)
ActiveCell.Offset(, 2).Resize(dicResults.Count).Value = Application.Transpose(dicResults.Items)
[COLOR=darkblue]Else[/COLOR]
MsgBox "No work numbers were found!", vbExclamation
End [COLOR=darkblue]If[/COLOR]
End Sub