Creating a unique list between dates

K

Kellogg

New Member
Joined
Mar 30, 2013
Messages
41
Platform
  1. Windows
  2. MacOS
Dear Great Minds of Excel,

I have a code I found on this site that creates a unique list and would like to modify it to create a unique list, in numerical code order, if the values fall between two dates.
Codes are listed in Column C. Dates are listed in Column D. The date range will be on a userform but I reference them on the "Report" worksheet in Cell "A1" and "A2". I have several worksheets that the code will act upon and store the final list in one column on the worksheet "Report". My worksheets are all called PCODE1, PCODE2, PCODE3, PCODE4, PCODE5, PCODE6, PCODE7, PCODE7, PCODE8, and PCODE9. I do not need the date column, just included it as a reference to the activity that occurred during the date range. Column B and Column C is the expected results of the code.

Here are example sheets of the start and finished results.

START
(this sheet name is "PCODE1")
[TABLE="width: 500"]
<tbody>[TR]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[TD]Column D
[/TD]
[/TR]
[TR]
[TD]Activity Survey
[/TD]
[TD]Code
[/TD]
[TD]Date
[/TD]
[/TR]
[TR]
[TD]Survey
[/TD]
[TD]1001
[/TD]
[TD]2/1/13
[/TD]
[/TR]
[TR]
[TD]Control
[/TD]
[TD]1002
[/TD]
[TD]2/9/13
[/TD]
[/TR]
[TR]
[TD]Control
[/TD]
[TD]1002
[/TD]
[TD]3/5/13
[/TD]
[/TR]
[TR]
[TD]Inspection
[/TD]
[TD]1008
[/TD]
[TD]2/22/13
[/TD]
[/TR]
[TR]
[TD]Survey
[/TD]
[TD]1001
[/TD]
[TD]3/8/13
[/TD]
[/TR]
[TR]
[TD]Survey
[/TD]
[TD]1001
[/TD]
[TD]2/1/13
[/TD]
[/TR]
[TR]
[TD]Treatment
[/TD]
[TD]1003
[/TD]
[TD]2/15/13
[/TD]
[/TR]
</tbody>[/TABLE]


(this sheet name is "PCODE2")
[TABLE="width: 500"]
<tbody>[TR]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[TD]Column D
[/TD]
[/TR]
[TR]
[TD]Activity Control
[/TD]
[TD]Code
[/TD]
[TD]Date
[/TD]
[/TR]
[TR]
[TD]Document 1 Issued
[/TD]
[TD]2001
[/TD]
[TD]2/7/13
[/TD]
[/TR]
[TR]
[TD]Document 2 Issued
[/TD]
[TD]2002
[/TD]
[TD]3/9/13
[/TD]
[/TR]
[TR]
[TD]Document 2 Issued
[/TD]
[TD]2002
[/TD]
[TD]2/5/13
[/TD]
[/TR]
[TR]
[TD]Quality Check
[/TD]
[TD]2008
[/TD]
[TD]2/22/13
[/TD]
[/TR]
[TR]
[TD]Quality Check
[/TD]
[TD]2008
[/TD]
[TD]3/8/13
[/TD]
[/TR]
[TR]
[TD]Quality Check
[/TD]
[TD]2008
[/TD]
[TD]1/1/13
[/TD]
[/TR]
[TR]
[TD]Control Monitoring
[/TD]
[TD]2010
[/TD]
[TD]2/15/13
[/TD]
[/TR]
</tbody>[/TABLE]


END - The results will be on sheet "Report" between Dates 2/1/13 to 2/28/13 located in Cells "A1" and "A2" respectively. I only need to have Columns B and C. I do not need the date column.

Desired Result
(this sheet name is "PCODE2")
[TABLE="width: 500"]
<tbody>[TR]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[/TR]
[TR]
[TD]Activity Control
[/TD]
[TD]Code
[/TD]
[/TR]
[TR]
[TD]Survey
[/TD]
[TD]1001
[/TD]
[/TR]
[TR]
[TD]Control
[/TD]
[TD]1002
[/TD]
[/TR]
[TR]
[TD]Treatment
[/TD]
[TD]1003
[/TD]
[/TR]
[TR]
[TD]Inspection
[/TD]
[TD]1008
[/TD]
[/TR]
[TR]
[TD]Document 1 Issued
[/TD]
[TD]2001
[/TD]
[/TR]
[TR]
[TD]Document 2 Issued
[/TD]
[TD]2002
[/TD]
[/TR]
[TR]
[TD]Quality Check
[/TD]
[TD]2008
[/TD]
[/TR]
[TR]
[TD]Control Monitoring
[/TD]
[TD]2010
[/TD]
[/TR]
</tbody>[/TABLE]


What I have so far is the following:

Code: 
Sub UniqueList3()
    Dim vArr    As Variant
    Dim Dict    As Object
    Dim i       As Long
    Dim j       As Long
    Dim n As Integer
    Dim lnglastpc As Long
    Dim lnglastpd As Long

'Clear old data
    Range("A4:O1000").Select
    Selection.ClearContents
    Range("A4").Select

'Create Heading
Range("A4") = Sheets("PCODE1").Range("B8")
Range("B4") = Sheets("PCODEs").Range("C8")

'Find first available row on "Report" worksheet to list codes and description
n = Range("B" & Rows.count).End(xlUp).Row + 1

    vArr = Sheets("PCODE1").Range("C9:C1000").Value2
    
    ' initialise dictionary
    Set Dict = CreateObject("scripting.dictionary")
        
    With Dict
        
        ' case-insensitive comparison
        .CompareMode = vbTextCompare
        
        ' store distinct values from column A as keys
        ' (ignoring blank cells)
        For i = 1 To UBound(vArr, 1)
            For j = 1 To UBound(vArr, 2)
                If Len(vArr(i, j)) > 0 Then
                    If Not .Exists(vArr(i, j)) Then _
                           .Add Key:=vArr(i, j), Item:=0
                End If
            Next j
        Next i
            
        ' print output array
        Range("B" & n).Resize(.count, 1) = _
            Application.Transpose(.Keys)
    End With
The code lists all the unique code values from worksheet(PCODE1) and lists on worksheet (Report) but I need to modify to include the activity heading and descriptions in Column B that corresponds to Column C then the ability to check all other PCODE sheets and list as described. I hope this post was clear. any help is greatly appreciated. Thank you in advance.

Craig
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
Dear Great Minds of Excel,

I realize my request was a tall order. I have worked on a couple of strategies and the following is promising. However, I'm still hung up. I have the modified my original code to the code below. It now searches all the worksheets, captures all the headings, and develops a unique list but not in the order I need or between dates. I'm still looking to take each individual heading and unique code list from each worksheet and consolidate on a report summary page. I have 10 worksheets named PCODE1 through PCODE 9 and 1 named Report. The user form has a start and end date text box labelled tbxStart and tbxEnd. Each PCODE worksheet looks like the following:

tbxStart = 02/01/13 tbxEnd = 02/28/13

Worksheet Example - PCODE1
[TABLE="width: 500"]
<tbody>[TR]
[TD]Rows[/TD]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[/TR]
[TR]
[TD]Row 8[/TD]
[TD="align: center"]Log Entry No. [/TD]
[TD]PCODE: 1 Activity[/TD]
[TD]Code[/TD]
[TD]Date[/TD]
[/TR]
[TR]
[TD]Row 9[/TD]
[TD="align: center"]1[/TD]
[TD]No Activity[/TD]
[TD]1010[/TD]
[TD]2/6/13[/TD]
[/TR]
[TR]
[TD]Row 10[/TD]
[TD="align: center"]2[/TD]
[TD]Survey[/TD]
[TD]1001[/TD]
[TD]2/1/13[/TD]
[/TR]
[TR]
[TD]Row 11[/TD]
[TD="align: center"]3[/TD]
[TD]Control[/TD]
[TD]1002[/TD]
[TD]2/9/13[/TD]
[/TR]
[TR]
[TD]Row 12[/TD]
[TD="align: center"]4[/TD]
[TD]Control[/TD]
[TD]1002[/TD]
[TD]3/8/13[/TD]
[/TR]
[TR]
[TD]Row 13[/TD]
[TD="align: center"]5[/TD]
[TD]Insp[/TD]
[TD]1008[/TD]
[TD]4/1/13[/TD]
[/TR]
[TR]
[TD]Row 14[/TD]
[TD="align: center"]6[/TD]
[TD]Survey[/TD]
[TD]1001[/TD]
[TD]3/5/13[/TD]
[/TR]
</tbody>[/TABLE]


Worksheet Example - PCODE2
[TABLE="width: 500"]
<tbody>[TR]
[TD]Rows[/TD]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[/TR]
[TR]
[TD]Row 8[/TD]
[TD="align: center"]Log Entry No. [/TD]
[TD]PCODE: 2 Activity[/TD]
[TD]Code[/TD]
[TD]Date[/TD]
[/TR]
[TR]
[TD]Row 9[/TD]
[TD="align: center"]1[/TD]
[TD]Monitor[/TD]
[TD]2001[/TD]
[TD]2/6/13[/TD]
[/TR]
[TR]
[TD]Row 10[/TD]
[TD="align: center"]2[/TD]
[TD]Monitor[/TD]
[TD]2001[/TD]
[TD]2/1/13[/TD]
[/TR]
[TR]
[TD]Row 11[/TD]
[TD="align: center"]3[/TD]
[TD]QA Examine[/TD]
[TD]2002[/TD]
[TD]2/9/13[/TD]
[/TR]
[TR]
[TD]Row 12[/TD]
[TD="align: center"]4[/TD]
[TD]QA Examine[/TD]
[TD]2002[/TD]
[TD]3/8/13[/TD]
[/TR]
[TR]
[TD]Row 13[/TD]
[TD="align: center"]5[/TD]
[TD]Reset[/TD]
[TD]2008[/TD]
[TD]4/1/13[/TD]
[/TR]
[TR]
[TD]Row 14[/TD]
[TD="align: center"]6[/TD]
[TD]Rebuild[/TD]
[TD]2006[/TD]
[TD]2/20/13[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

When I run the code below I get the following:

Worksheet Example - REPORT
[TABLE="width: 500"]
<tbody>[TR]
[TD]Rows[/TD]
[TD="align: left"]Column A[/TD]
[TD="align: left"]Column B[/TD]
[/TR]
[TR]
[TD="align: left"]Row 3[/TD]
[TD="align: left"]Activity[/TD]
[TD="align: left"]Code[/TD]
[/TR]
[TR]
[TD="align: left"]Row 4[/TD]
[TD="align: left"]PCODE: 1 Activity[/TD]
[TD="align: left"]Code[/TD]
[/TR]
[TR]
[TD="align: left"]Row 5[/TD]
[TD="align: left"]PCODE: 2 Activity[/TD]
[TD="align: left"]Code[/TD]
[/TR]
[TR]
[TD="align: left"]Row 6[/TD]
[TD="align: left"][/TD]
[TD="align: left"]1001[/TD]
[/TR]
[TR]
[TD="align: left"]Row 7[/TD]
[TD="align: left"][/TD]
[TD="align: left"]1002[/TD]
[/TR]
[TR]
[TD="align: left"]Row 8[/TD]
[TD="align: left"][/TD]
[TD="align: left"]1010[/TD]
[/TR]
[TR]
[TD="align: left"]Row 9[/TD]
[TD="align: left"][/TD]
[TD="align: left"]Code[/TD]
[/TR]
[TR]
[TD="align: left"]Row 10[/TD]
[TD="align: left"][/TD]
[TD]2001[/TD]
[/TR]
[TR]
[TD="align: left"]Row 11[/TD]
[TD="align: left"][/TD]
[TD]2002[/TD]
[/TR]
[TR]
[TD="align: left"]Row 12[/TD]
[TD="align: left"][/TD]
[TD]2006[/TD]
[/TR]
</tbody>[/TABLE]


What I'm trying to eventually get to is:

Worksheet Example - REPORT
[TABLE="width: 500"]
<tbody>[TR]
[TD]Rows[/TD]
[TD="align: left"]Column A[/TD]
[TD="align: left"]Column B[/TD]
[/TR]
[TR]
[TD="align: left"]Row 3[/TD]
[TD="align: left"]Activity[/TD]
[TD="align: left"]Code[/TD]
[/TR]
[TR]
[TD="align: left"]Row 4[/TD]
[TD="align: left"]PCODE: 1 Activity[/TD]
[TD="align: left"]Code[/TD]
[/TR]
[TR]
[TD="align: left"]Row 5[/TD]
[TD="align: left"]Survey[/TD]
[TD="align: left"]1001[/TD]
[/TR]
[TR]
[TD="align: left"]Row 6[/TD]
[TD="align: left"]Control[/TD]
[TD="align: left"]1002[/TD]
[/TR]
[TR]
[TD="align: left"]Row 7[/TD]
[TD="align: left"]No Activity[/TD]
[TD="align: left"]1010[/TD]
[/TR]
[TR]
[TD="align: left"]Row 8[/TD]
[TD="align: left"]PCODE: 2 Activity[/TD]
[TD="align: left"]Code[/TD]
[/TR]
[TR]
[TD="align: left"]Row 9[/TD]
[TD="align: left"]Monitor[/TD]
[TD]2001[/TD]
[/TR]
[TR]
[TD="align: left"]Row 10[/TD]
[TD="align: left"]QA Examine[/TD]
[TD]2002[/TD]
[/TR]
[TR]
[TD="align: left"]Row 11[/TD]
[TD="align: left"]Rebuild[/TD]
[TD]2006[/TD]
[/TR]
</tbody>[/TABLE]


Any suggestions would be helpful. I'm truly stumped on this array portion.



Code: 
Sub UniqueList3()
'set up variables
    Dim vArr    As Variant
    Dim Dict    As Object
    Dim i       As Long
    Dim ii       As Long
    Dim j       As Long
    Dim n
    Dim lnglastpc As Long
    Dim lnglastpd As Long
'    lnglastpc = Range("O" & Rows.count).End(xlUp).Row
'    lnglastpd = Range("A" & Rows.count).End(xlUp).Row
    Dim sh As Worksheet
    Dim FValue As String
    Dim SumSheet As String


    If Sheets("Report").Visible = True Then '@@@@@
    Sheets("Report").Select
'
'Clear old data
    Range("A4:O1000").Select
    Selection.ClearContents
    Range("A4").Select
'
'Set up for all PCODE sheets
'
'What is the name of summary sheet?
SumSheet = "REPORT"
'Which row in Summary sheet are we starting on?
ii = 4
'Which column in summary sheet?
X = "A"
'
FValue = "PCODEs" 'Range("A1").Value
'
With Worksheets(SumSheet)
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> SumSheet Then
            If ws.Range("A1") = FValue Then
'Create Heading
                .Cells(ii, X) = ws.Range("B8").Value  'PCODE Desc
                .Cells(ii, X).Offset(0, 1) = ws.Range("C8").Value  'Code
'
'
'00000000000000000000000000000000000000000
    n = Range("B" & Rows.count).End(xlUp).Row + 1
    ' assign range to array
    'vArr = Sheets("PCODEs").Range("A2:A50").Value2
    vArr = ws.Range("C2:C50").Value2


    ' initialise dictionary
    Set Dict = CreateObject("scripting.dictionary")

    With Dict

        ' case-insensitive comparison
        .CompareMode = vbTextCompare

        ' store distinct values from column A as keys
        ' (ignoring blank cells)
        For i = 1 To UBound(vArr, 1)
            For j = 1 To UBound(vArr, 2)
                If Len(vArr(i, j)) > 0 Then
                    If Not .Exists(vArr(i, j)) Then _
                           .Add Key:=vArr(i, j), Item:=0
                End If
            Next j
        Next i
            
        ' print output array
        Sheets("REPORT").Range("B" & n).Resize(.count, 1) = _
            Application.Transpose(.Keys)
    End With
'0000000000000000000000000000000000000000000000

                '
                ii = ii + 1
            End If
        End If
    Next ws
End With
'
'
'lock
'ActiveSheet.protect
'
'
End If '@@@@@
End Sub
 
Upvote 0
Thanks to jindon from ozgrid for the following solution

Code: 
Sub test() 
    Dim ws As Worksheet, a, i As Long, txt As String, n As Long, e 
    Dim sDate As Date, eDate As Date 
    sDate = [report!b1].Value: eDate = [report!c1].Value 
    With CreateObject("Scripting.Dictionary") 
        For Each ws In Worksheets 
            If ws.Name Like "PCODE*" Then 
                a = ws.Range("a8", ws.Range("a" & Rows.Count).End(xlUp)).Resize(, 4).Value 
                Set .Item(a(1, 2)) = CreateObject("System.Collections.SortedList") 
                For i = 2 To UBound(a, 1) 
                    If (a(i, 4) >= sDate) * (a(i, 4) <= eDate) Then 
                        txt = Join(Array(Format$(a(i, 3), "0000000000"), a(i, 2)), Chr(2)) 
                        .Item(a(1, 2))(txt) = a(i, 3) 
                    End If 
                Next 
                n = n + .Item(a(1, 2)).Count 
            End If 
        Next 
        Redim a(1 To .Count + n + 1, 1 To 2) 
        a(1, 1) = "Activity": n = 1: txt = "" 
        For Each e In .keys 
            n = n + 1: a(n, 1) = e: a(n, 2) = "Code" 
            txt = txt & "," & n 
            For i = 0 To .Item(e).Count - 1 
                n = n + 1: a(n, 1) = Split(.Item(e).GetKey(i), Chr(2))(1): a(n, 2) = .Item(e).GetByIndex(i) 
            Next 
        Next 
    End With 
    With Sheets("report").Range("a3").Resize(n, 2) 
        .CurrentRegion.Offset(3).Clear 
        .Value = a 
        .Rows(1).Font.Bold = True 
        For Each e In Split(Mid$(txt, 2), ",") 
            .Rows(e).Font.Bold = True 
        Next 
        .Parent.Activate 
    End With 
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Creating Unique list from Customer Order Amount, Customer Name and Order Identifier using the Unique function
2
Replies
11
Views
311
etaf
etaf
N
  • Question Question
Pivot graph data when creating a new tab from a template.
Replies
0
Views
239
Nippyzap
N
B
  • Question Question
Excel VBA Searching Unique Variables to Match against Exported Schedule Files to Determine Date
Replies
1
Views
124
sijpie
sijpie
S
  • Question Question
List all staff names that worked under a manager on a certain date
Replies
5
Views
307
Fluff
Fluff
X
  • Question Question
VBA for extracting specific data from PDF Docs
Replies
3
Views
606
xcellrodeo
X

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

Share this page

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