search array values in a column and return another column

amsaini15 · Aug 31, 2014

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.

Domenic · Aug 31, 2014

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!

amsaini15 · Aug 31, 2014

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

PTW No

PTW End Date

SiteCode

CHG0081150

29/08/2014

65MV
65MV

CHG0082838

29/08/2014

12WG
32ZH
12KF
52WA
13HU
M3WW
92JC
22JI
22JI
O2YH
42RM

CHG0081513

30/08/2014

S2DL
S2LE
2NWP
S2RW

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

PTW No

PTW End Date

SiteCode

CHG0083744

08/09/2014

22JI
22JI
O2YH

CHG0082838

29/08/2014

12WG
32ZH
12KF
52WA
13HU
M3WW
92JC
22JI
22JI
O2YH
42RM

CHG0080113

13/08/2014

S2RW

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

Domenic · Aug 31, 2014

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!

amsaini15 · Sep 1, 2014

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

Planned Work No	End Date	SiteCode
CHG0079370	10/08/2014	36WO (Row (1043 of the sheet)
CHG0079687	10/08/2014	36WO (Row 1153)
CHG0079519	31/08/2014	36WO (Row 1090) 36WO 36WO

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

Planned Work No	End Date	SiteCode
CHG0082227	14/09/2014	42RS 42RS 42RS
CHG0079758	31/08/2014	42RS 32PZ <wbr> S2YC <wbr> 62IU <wbr> 22BQ
CHG0081629	01/09/2014	O2BT O2BT <wbr> <wbr>22BQ <wbr> <wbr>42RS <wbr> <wbr>42RS <wbr> <wbr>S2TB

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

Domenic · Sep 1, 2014

amsaini15 said:
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

Planned Work No
End Date
SiteCode

CHG0082227
14/09/2014
42RS
42RS
42RS

CHG0079758
31/08/2014
42RS
32PZ
<WBR>S2YC
<WBR>62IU
<WBR>22BQ

CHG0081629
01/09/2014
O2BT
O2BT
<WBR><WBR>22BQ
<WBR><WBR>42RS
<WBR><WBR>42RS
<WBR><WBR>S2TB

<TBODY>
</TBODY>

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?

amsaini15 · Sep 1, 2014

Thanks once again, Domenic.

Domenic said:
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

	Column A	Column B	Column C	Column D	Column E
Row1	PTW No.	PTW End Date	Site Code	Search Result (Planned Work No)	Search Result) End Date
Row2	CHG0079519	31/08/2014	36WO 36WO 36WO
Row3	CHG0081629	01/09/2014	O2BT O2BT 22BQ 42RS 42RS S2TB	CHG0082227	14/09/2014
Row4	CHG0083744	08/09/2014	22JI 22JI O2YH	CHG0079758	31/08/2014
Row5	CHG0080113	13/08/2014	S2RW	CHG0081629	01/09/2014
Row6

Domenic said:
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.

Domenic · Sep 2, 2014

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!

amsaini15 · Sep 3, 2014

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

PTWREF

REPORTEDDATE

MOBILECONTACT

CHG0077755

01-09-14 08:45

CHG0077755

30-08-14 12:29

CHG0085423

31-08-14 09:00

CHG0083824

31-08-14 12:29

CHG0077755

01-09-14 15:20

CHG0077755

01-09-14 10:11

CHG0082227

30-08-14 16:03

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

Date	Number of Reports
30-08-14	1
01-09-14	3

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

Date	Total Reports
31/08/2014	2
01/09/2014	3

I am struggling with Date formatting which is important in coming up with above resulting tables and charts.

Domenic · Sep 3, 2014

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!

search array values in a column and return another column

amsaini15

New Member

Excel Facts

Domenic

MrExcel MVP

amsaini15

New Member

Domenic

MrExcel MVP

amsaini15

New Member

Domenic

MrExcel MVP

amsaini15

New Member

Domenic

MrExcel MVP

amsaini15

New Member

Domenic

MrExcel MVP

Similar threads

Forum statistics

Share this page

search array values in a column and return another column

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock