search array values in a column and return another column

amsaini15

New Member
Joined
Aug 31, 2014
Messages
14
Hi
First time post. I am trying to develop a code in VBA for searching Site codes (copied in a Array) in a Column of another worksheet. Site codes are always 4 character long.

For e.g. I have a cell with value "12WG32ZH12KF52WA13HUM3WW92JC22JI22JIO2YH42RM". I have broken this string into 4 character each and copied into a array using MID function

For a = 1 To SitecodeDivided
Arr(a) = Mid(Sitecode, 4 * a - 3, 4)
Next a

Now my array is
Arr(1) = 12WG
Arr(2)=32ZH
. .
. .
Arr(11)=42RM
so on

I would like to search each of the Array values (12WG,32ZH, etc) in a column of another worksheet and return another column (Planned work No) as a result when match is found.

Basically I am looking for all planned works with particular site codes (stored in a array) in the the master data sheet . Would vlookup help?

I hope I have been able to explain my dilemma. Please let me know if anything is not clear. I am not sure how can I provide screenshots to explain better.

Thanks a lot for your help.
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Try...

Code:
[COLOR=green]'Declare these additional variables[/COLOR]
[COLOR=darkblue]Dim[/COLOR] vMatchVal       [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
[COLOR=darkblue]Dim[/COLOR] aResults()      [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
[COLOR=green]'[/COLOR]
'
'
'
'
[COLOR=green]'Re-allocate storage space to store the results[/COLOR]
[COLOR=darkblue]ReDim[/COLOR] aResults(1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](Arr))

[COLOR=green]'Lookup values from Arr and store the results in aResults[/COLOR]
[COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](Arr) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](Arr)
    [COLOR=darkblue]With[/COLOR] Worksheets("Master") [COLOR=green]'change the name of the master sheet accordingly[/COLOR]
        vMatchVal = Application.Match(Arr(i), .Range("A2:A100"), 0) [COLOR=green]'change the lookup range accordingly[/COLOR]
        aResults(i) = Application.Index(.Range("B2:B100"), vMatchVal) [COLOR=green]'change the return range accordingly[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]Next[/COLOR] I

[COLOR=green]'Transfer the results from aResults to a vertical range of cells in Sheet2, starting at B2[/COLOR]
Worksheets("Sheet2").Range("B2").Resize(UBound(aResults)).Value = Application.Transpose(aResults)

Hope this helps!
 
Upvote 0
Thanks a lot for your reply Domenic. I am receiving error vMatchval= Error 2042 with above code. I will try to explain better with the use of tables and data.

PT 4 Worksheet

[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]PTW No[/TD]
[TD]PTW End Date[/TD]
[TD]SiteCode[/TD]
[/TR]
[TR]
[TD][TABLE="width: 96"]
<tbody>[TR]
[TD="width: 96"]CHG0081150[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]29/08/2014[/TD]
[TD][TABLE="width: 147"]
<tbody>[TR]
[TD="class: xl65, width: 147"]65MV
65MV[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 96"]
<tbody>[TR]
[TD="width: 96"]CHG0082838[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]29/08/2014[/TD]
[TD][TABLE="width: 147"]
<tbody>[TR]
[TD="class: xl65, width: 147"]12WG
32ZH
12KF
52WA
13HU
M3WW
92JC
22JI
22JI
O2YH
42RM[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 96"]
<tbody>[TR]
[TD="width: 96"]CHG0081513[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]30/08/2014[/TD]
[TD][TABLE="width: 147"]
<tbody>[TR]
[TD="class: xl65, width: 147"]S2DL
S2LE
2NWP
S2RW[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]


First of all, I have selected a cell under SiteCode and cleaned up to remove Enter and spaces.
Code:
Sitecode = ActiveCell.Value
Sitecode = Application.WorksheetFunction.Clean(Sitecode)
' If C3 is selected, I get Sitecode = "12WG32ZH12KF52WA13HUM3WW92JC22JI22JIO2YH42RM"

Then I have broken the value of variable Sitecode into 4 characters each and stored them in a array - Arr.
Code:
Dim SitecodeDivided As Variant
SitecodeDivided = Len(Sitecode) / 4
ReDim Arr(SitecodeDivided) As String
For a = 1 To SitecodeDivided
     Arr(a) = Mid(Sitecode, 4 * a - 3, 4)
Next a

Array now has
Arr[1]="12WG"
Arr[2]="32ZH"
.
Arr[11]="42RM"

I have another worksheet "SM9 Export' with following columns. This is the Master Data having all the Planned Work No with their Site code. Each Site code can have multiple planned works and hence multiple Planned work No can be returned.

SM9 Export Worksheet


[TABLE="class: outer_border, width: 500"]
<tbody>[TR]
[TD]PTW No[/TD]
[TD]PTW End Date[/TD]
[TD]SiteCode[/TD]
[/TR]
[TR]
[TD][TABLE="width: 96"]
<tbody>[TR]
[TD="width: 96"][TABLE="width: 82"]
<tbody>[TR]
[TD="width: 82"]CHG0083744[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]08/09/2014[/TD]
[TD][TABLE="width: 147"]
<tbody>[TR]
[TD="class: xl65, width: 147"]22JI
22JI
O2YH[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 96"]
<tbody>[TR]
[TD="width: 96"]CHG0082838[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]29/08/2014[/TD]
[TD][TABLE="width: 147"]
<tbody>[TR]
[TD="class: xl65, width: 147"]12WG
32ZH
12KF
52WA
13HU
M3WW
92JC
22JI
22JI
O2YH
42RM[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 96"]
<tbody>[TR]
[TD="width: 96"][TABLE="width: 82"]
<tbody>[TR]
[TD="width: 82"]CHG0080113[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]13/08/2014[/TD]
[TD][TABLE="width: 147"]
<tbody>[TR]
[TD="class: xl65, width: 147"]S2RW[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]



With the search in SM9 Export worksheet, I would like to search each of the Array values stored earlier in the column C2 to C4000 and provide outcome of all Planned work No. which have any of the Array values without duplicating. If searching for Arr[8]="22JI", it should find CHG0083744 and CHG0082838 and then searching for Arr[10]="O2YH', it should not duplicate with results CHG0083744 and CHG0082838 as they have already been found with Arr[8] search.

I think I need to cleanup each cell of column C of SM9 Export worksheet in the For loop before I look for matching strings from the array?

So far I have added Domenic's code but it gives error

Code:
'Declare these additional variables
Dim vMatchVal       As Variant
Dim aResults()      As Variant


'
'Re-allocate storage space to store the results
ReDim aResults(1 To UBound(Arr))


'Lookup values from Arr and store the results in aResults
For I = LBound(Arr) To UBound(Arr)
    With Worksheets("SM9 Export") 'change the name of the master sheet accordingly
        vMatchVal = Application.Match(Arr(I), .Range("C2:C4000"), 0)    '   Lookup range changed to column C of SM9 Export worksheet  
         ' In the Debug Window, I get error -   : vMatchVal : Error 2042 : Variant/Error
        aResults(I) = Application.Index(.Range("A2:A100"), vMatchVal) 'change the return range accordingly
    End With
Next I

'Transfer the results from aResults to a vertical range of cells in Sheet2, starting at B2
Worksheets("PT 4").Range("I6").Resize(UBound(aResults)).Value = Application.Transpose(aResults)


I hope I have been to explain it better. Please help !!!!!!! Thanks
 
Upvote 0
Try the following macro instead...

Code:
[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit
[/COLOR]
[COLOR=darkblue]Sub[/COLOR] RetrieveWorkNumbers()

    [COLOR=darkblue]Dim[/COLOR] dicWorkNumbers              [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] arrSiteCodes()              [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] rngSiteCode                 [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] rngWorkNumber               [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] strSiteCode                 [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] strWorkNumber               [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/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]If[/COLOR] ActiveCell [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    
    [COLOR=darkblue]Const[/COLOR] SubStringLength [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR] = 4
    
    strSiteCode = Trim(ActiveCell.Value)
    strSiteCode = Application.WorksheetFunction.Clean(strSiteCode)
    
    [COLOR=darkblue]If[/COLOR] Len(strSiteCode) = 0 [COLOR=darkblue]Then[/COLOR]
        MsgBox "The active cell is empty...", vbExclamation
        [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
    TotalSubStrings = Len(strSiteCode) / SubStringLength
    
    [COLOR=darkblue]If[/COLOR] Int(Total[COLOR=darkblue]Sub[/COLOR]Strings) <> TotalSubStrings [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]ReDim[/COLOR] arrSiteCodes(1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]To[/COLOR]talSubStrings)
    
    [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] TotalSubStrings
        arrSiteCodes(i) = Mid(strSiteCode, i * [COLOR=darkblue]Sub[/COLOR]StringLength - SubStringLength + 1, SubStringLength)
    [COLOR=darkblue]Next[/COLOR] i
    
    [COLOR=darkblue]Set[/COLOR] dicWorkNumbers = CreateObject("Scripting.Dictionary")
    dicWorkNumbers.CompareMode = 1 [COLOR=green]'vbTextCompare[/COLOR]
    
    [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](arrSiteCodes) To [COLOR=darkblue]UBound[/COLOR](arrSiteCodes)
        [COLOR=darkblue]With[/COLOR] Worksheets("SM9 Export")
            [COLOR=darkblue]Set[/COLOR] rngSiteCode = .Columns("C").Find(what:=arrSiteCodes(i), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
            [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] rngSiteCode [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
                [COLOR=darkblue]Set[/COLOR] rngWorkNumber = .Range("A" & rngSiteCode.Row)
                [COLOR=darkblue]If[/COLOR] Len(rngWorkNumber) > 0 [COLOR=darkblue]Then[/COLOR]
                    strWorkNumber = rngWorkNumber.Value
                [COLOR=darkblue]Else[/COLOR]
                    strWorkNumber = rngWorkNumber.End(xlUp)
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
                [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] dicWorkNumbers.Exists(strWorkNumber) [COLOR=darkblue]Then[/COLOR]
                    dicWorkNumbers.Add strWorkNumber, strWorkNumber
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
    [COLOR=darkblue]With[/COLOR] Worksheets("PT 4")
        .Range("I6").CurrentRegion.ClearContents
        .Activate
        [COLOR=darkblue]If[/COLOR] dicWorkNumbers.Count > 0 [COLOR=darkblue]Then[/COLOR]
            .Range("I6").Resize(dicWorkNumbers.Count).Value = Application.Transpose(dicWorkNumbers.keys)
        [COLOR=darkblue]Else[/COLOR]
            MsgBox "No work numbers were found!", vbExclamation
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With
[/COLOR]
End Sub

Hope this helps!
 
Upvote 0
Domenic,
I couldn't believe my eyes when your code worked straight away without any error (for a single SiteCode when there is only 1 search result in SM9 Export spreadsheet) . You are genius, mate. :) There is no way I could have figure that out.


Just have some issues.


1. Active Cell has "36WO36WO36WO" ,

and


SM9 Export spreadsheet has


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Planned Work No[/TD]
[TD]End Date[/TD]
[TD]SiteCode[/TD]
[/TR]
[TR]
[TD]CHG0079370[/TD]
[TD]10/08/2014[/TD]
[TD]36WO (Row (1043 of the sheet)[/TD]
[/TR]
[TR]
[TD]CHG0079687[/TD]
[TD]10/08/2014[/TD]
[TD]36WO (Row 1153)[/TD]
[/TR]
[TR]
[TD]CHG0079519[/TD]
[TD]31/08/2014[/TD]
[TD]36WO (Row 1090)
36WO
36WO[/TD]
[/TR]
</tbody>[/TABLE]




Currently, it returns "CHG0079370" in I6 (output cell) only. It seems it stops looking for the next instance of "36WO" after finding first one at row 1043. Can we get it to keep searching for strSiteCode till the end of the sheet and report back multiple search results? The result should be CHG0079370 in I6 and CHG0079687 I7. (or better still we can get output in column next to the Active cell i.e. Column "D" and in the same row as Active cell).

So basically, it is giving 1 result only even if strSiteCode can be located 2-4 times in 'SM9 Export' spreadsheet. I would need all 3 in results above.

Also I think it is searching with "Match entire cell contents" option turned ON which is not allowing it to find the 3rd result above. Not finding "36WO" when searching

"36WO
36WO
36WO"


2. Active Cell has

"32PZ
S2YC
62IU
22BQ
O2BT
O2BT
22BQ
42RS
42RS
S2TB"




SM9 Export sheet has


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Planned Work No[/TD]
[TD]End Date[/TD]
[TD]SiteCode[/TD]
[/TR]
[TR]
[TD]CHG0082227[/TD]
[TD]14/09/2014[/TD]
[TD]42RS
42RS
42RS[/TD]
[/TR]
[TR]
[TD]CHG0079758[/TD]
[TD]31/08/2014[/TD]
[TD] 42RS
32PZ
<wbr> S2YC
<wbr> 62IU
<wbr> 22BQ[/TD]
[/TR]
[TR]
[TD]CHG0081629[/TD]
[TD]01/09/2014[/TD]
[TD] O2BT
O2BT
<wbr> <wbr>22BQ
<wbr> <wbr>42RS
<wbr> <wbr>42RS
<wbr> <wbr>S2TB[/TD]
[/TR]
</tbody>[/TABLE]




Searching strSiteCode from the above Active cell, I would like to get all the 3 above results.


So basically, code needs modification to provide all search results and search any occurance of Site code in column 'C' of the SM9 Export spreadsheet.
Also if it is possible, can we output End Date as well along with Work Number? This will probably have another line added like

Set rngWorkNumber = .Range("A" & rngSiteCode.Row)
Set rngWorkEndDate = .Range("B" & rngSiteCode.Row)


I really appreciate your help mate. As I said, I would have made complex code which may or may not have worked. Please assist further. Thanks
 
Last edited:
Upvote 0
Also I think it is searching with "Match entire cell contents" option turned ON which is not allowing it to find the 3rd result above.

Actually, I thought those entries were in separate cells. So I'll make the necessary change. Also, we can now get rid of a few lines of code that are no longer needed. I'll make this change as well.

SM9 Export sheet has


[TABLE="class: grid, width: 500"]
<TBODY>[TR]
[TD]Planned Work No
[/TD]
[TD]End Date
[/TD]
[TD]SiteCode
[/TD]
[/TR]
[TR]
[TD]CHG0082227
[/TD]
[TD]14/09/2014
[/TD]
[TD]42RS
42RS
42RS
[/TD]
[/TR]
[TR]
[TD]CHG0079758
[/TD]
[TD]31/08/2014
[/TD]
[TD]42RS
32PZ
<WBR>S2YC
<WBR>62IU
<WBR>22BQ
[/TD]
[/TR]
[TR]
[TD]CHG0081629
[/TD]
[TD]01/09/2014
[/TD]
[TD]O2BT
O2BT
<WBR><WBR>22BQ
<WBR><WBR>42RS
<WBR><WBR>42RS
<WBR><WBR>S2TB
[/TD]
[/TR]
</TBODY>[/TABLE]

Just to be clear, can you provide me with the expected results for "42RS" in the following 3 examples based on the above sample data?

Example 1:

"32PZ
S2YC
62IU
22BQ
O2BT
O2BT
22BQ
42RS
S2TB"

Example 2:

"32PZ
S2YC
62IU
22BQ
O2BT
O2BT
22BQ
42RS
42RS
S2TB"

Example 3:

"32PZ
S2YC
62IU
22BQ
O2BT
O2BT
42RS
42RS
42RS
S2TB"

Also if it is possible, can we output End Date as well along with Work Number? This will probably have another line added like

Can you also clarify where you'd like to place the work numbers and corresponding end dates?
 
Upvote 0
Thanks once again, Domenic.

Just to be clear, can you provide me with the expected results for "42RS" in the following 3 examples based on the above sample data?


So the output should look like this:
Active Cell is C3 of spreadsheet "PT 4".
Column D & E (coming from "SM9 Export" sheet) are the results of our function on the Active Cell selection
Outcome in D & E will consists of results of search of all site codes (O2BT, 22BQ, 42RS, S2TB). Outcome can go down to number of Rows. When selecting a different Active cell, results can be placed in the same row and at column next to it (This will clear of previous results in column D & E).
e.g. if Active cell is C4, outcome of all siteCode search (22JI, 22JI, O2YH) will show starting from D4 (Planned work No), & E4 (End result) and then going down to D5 E5 , D6 E6 , etc if more results are found.

Example 1, Example 2 & Example 3 will have same outcome. Planned work No is not duplicated in result.

"PT 4" Spreadsheet


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[TD]Column E[/TD]
[/TR]
[TR]
[TD]Row1[/TD]
[TD]PTW No.[/TD]
[TD]PTW End Date[/TD]
[TD]Site Code[/TD]
[TD]Search Result (Planned Work No)[/TD]
[TD]Search Result) End Date[/TD]
[/TR]
[TR]
[TD]Row2[/TD]
[TD]CHG0079519[/TD]
[TD]31/08/2014[/TD]
[TD]36WO
36WO
36WO[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row3[/TD]
[TD]CHG0081629[/TD]
[TD]01/09/2014[/TD]
[TD]O2BT
O2BT
22BQ
42RS
42RS
S2TB[/TD]
[TD]CHG0082227[/TD]
[TD]14/09/2014[/TD]
[/TR]
[TR]
[TD]Row4[/TD]
[TD]CHG0083744[/TD]
[TD]08/09/2014[/TD]
[TD]22JI
22JI
O2YH[/TD]
[TD]CHG0079758[/TD]
[TD]31/08/2014[/TD]
[/TR]
[TR]
[TD]Row5[/TD]
[TD]CHG0080113[/TD]
[TD]13/08/2014[/TD]
[TD]S2RW[/TD]
[TD]CHG0081629[/TD]
[TD]01/09/2014[/TD]
[/TR]
[TR]
[TD]Row6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]




Can you also clarify where you'd like to place the work numbers and corresponding end dates?

I hope above expected table clarifies how the output should look like. Results will be placed in the columns next to the Active cell. Previous Results can be cleared if another Active cell is selected.
 
Upvote 0
Try...

Code:
[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

Note that I've added some additional error checking.

Hope this helps!
 
Upvote 0
Hey Domenic, code works really well. I dont have words to express my Thanks to you. It would have taken me ages to play around with Dictionary object to come up with anything. God Bless you.

I am not sure how you guys manage to take time out of your precious time and help the community. I would need assistance with some more small VBA functions (This was the major one).
Would it be allright to hassle you guys here on forums? Please let me know. I am definitely learning along the way and trying to find solution extensively myself first.


---------------------------------
Please see if you can assist with below as well. Thanks a lot


Sheet: MapblasterData (It has 10+ columns but I am writing few only to keep it simple as these are the one I am interested in reporting

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][TABLE="width: 82"]
<tbody>[TR]
[TD="width: 82"]PTWREF[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 128"]
<tbody>[TR]
[TD="width: 128"]REPORTEDDATE[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 114"]
<tbody>[TR]
[TD="width: 114"]MOBILECONTACT[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][TABLE="width: 82"]
<tbody>[TR]
[TD="width: 82"]CHG0077755[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]01-09-14 08:45[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]CHG0077755[/TD]
[TD] 30-08-14 12:29[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]CHG0085423[/TD]
[TD] 31-08-14 09:00[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][TABLE="width: 82"]
<tbody>[TR]
[TD="width: 82"]CHG0083824[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]31-08-14 12:29[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]CHG0077755[/TD]
[TD] 01-09-14 15:20[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][TABLE="width: 82"]
<tbody>[TR]
[TD="width: 82"]CHG0077755[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]01-09-14 10:11[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][TABLE="width: 82"]
<tbody>[TR]
[TD="width: 82"]CHG0082227[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]30-08-14 16:03[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



I would like to create 2 Reports.

1. A combobox to load PTWREF values. On change event, I would like to see total number of reports against selected PTWREF with daily breakdown (I do not want Time details).

e.g. On Selecting "CHG0077755" in the combobox, Output should look like


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Number of Reports[/TD]
[/TR]
[TR]
[TD]30-08-14[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]01-09-14[/TD]
[TD]3[/TD]
[/TR]
</tbody>[/TABLE]

Also I would like to have a corresponding 2D chart plotted with Date on H-Axis and Number of complaints on Y-axis.


Code:
Private Sub CmbPTWList_Change()


strSQL = "SELECT [MapblasterData$].[REPORTEDDATE],Count([MapblasterData$].[REPORTEDDATE]) FROM [MapblasterData$] WHERE ([MapblasterData$].[PTWREF]) = '" & CmbPTWList.Text & "' GROUP BY [MAPBLASTERDATA$].[REPORTEDDATE],[MAPBLASTERDATA$].[PTWREF] ;"
            
closeRS
OpenDB


[B]'Also trying to load PTW End Date into a new textbox from 'SM9 Export' sheet with Vlookup command but no luck. [/B]
'Set SM9 = Workbooks(SM9 Export)
'EndDate = Application.VLookup(CmbPTWList.Text,SM9 Export.'!$A:$H,2,FALSE)
'=IF(LEN(cmbPTWList.text)=10 then (ISNA(VLOOKUP(B33,'SM9 Export'!$A:$H,2,FALSE))


rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
            
If rs.RecordCount > 0 Then
            Sheets("PTWRaised").Visible = True
            Sheets("PTWRaised").Select
            'Range("dataSet").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
            Range("B6:C50").Clear
            'Now putting the data on the sheet
            'ActiveCell.CopyFromRecordset rs
            Range("B6").CopyFromRecordset rs
Else
            MsgBox "I was not able to find any matching records.", vbExclamation + vbOKOnly
            closeRS
            Exit Sub
End If
            
Set cnn = Nothing
Set rs = Nothing  ' dispose the recordset
End Sub

PTWREF combobox is loading fine.
Problem with Above code: It is considering time in REPORTEDDATE field as well and hence showing 3 different rows for 01-09-2014 whereas I would like to consider day only.


2nd Report

Total Number of reports on each day between the 2 particular dates selected from Date picker (or any other Activex calendar control)Date Picker 1 = 31/08/2014 , Date Picker 2 = 01/09/2014

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Total Reports[/TD]
[/TR]
[TR]
[TD]31/08/2014[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]01/09/2014[/TD]
[TD]3[/TD]
[/TR]
</tbody>[/TABLE]


I am struggling with Date formatting which is important in
coming up with above resulting tables and charts.
 
Upvote 0
You're very welcome! I'm glad I could help!

With regards to your new question, unfortunately I won't be able to help. In any case, any new question should be posted in a new thread. So try posting your question in a new thread and hopefully someone will be able to help.

Cheers!
 
Upvote 0

Forum statistics

Threads
1,223,151
Messages
6,170,381
Members
452,322
Latest member
CrimsonCoure

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top