Sorting/Consolidating data using VBA -----------------------------------------Second Attempt-----------Please help----------------

[sssb2000]

Hi everyone,
thanks for looking.

i have the above raw data.......i'm trying to get to the output shown below using VBA. There is about 1600 rows of data in my raw data set and they need to be consolidated into the output table shown below.

there needs to be four of these output tables, one for each quarter.......ie. quarter one is jan. 1 to March 31, etc.


Your help is very much appreciated.

RAW Data:

Excel 2010
	A	N	O	P	Q	R	S	T
1	xxx	Max	Location	Title	Status	Start Date/Time	End Date/Time	xxx
2	*********	30	A	Course #mpkek234	CANCELLED	12/3/2012 8:00	12/3/2012 12:00	*********
3	*********	20	A	Course #mpkek234	ENROLLED	12/3/2012 8:00	12/3/2012 12:00	*********
4	*********	40	B	Course #mpkek234	ENROLLED	12/5/2012 8:00	12/6/2012 12:00	*********
5	*********	40	B	Course #mpkek234	ENROLLED	12/5/2012 8:00	12/6/2012 12:00	*********
6	*********	40	B	Course #mpkek234	CANCELLED	12/5/2012 8:00	12/6/2012 12:00	*********
7	*********	40	C	course 4k5jj3	CANCELLED	11/5/2012 8:00	11/9/2012 17:00	*********
8	*********	40	C	course 4k5jj3	CANCELLED	11/5/2012 8:00	11/9/2012 17:00	*********
9	*********	40	C	course 4k5jj3	ENROLLED	11/5/2012 8:00	11/9/2012 17:00	*********
10	*********	40	C	course 4k5jj3	WAITLIST	11/5/2012 8:00	11/9/2012 17:00	*********
11	*********	25	D	Course kk3kj	WAITLIST	3/12/2013 9:00	3/14/2013 18:00	*********
12	*********	25	D	Course kk3kj	WAITLIST	3/12/2013 9:00	3/14/2013 18:00	*********
13	*********	21	E	Course kk3kj	ENROLLED	11/6/2012 9:00	11/8/2012 18:00	*********
14	*********	21	E	Course kk3kj	ENROLLED	11/6/2012 9:00	11/8/2012 18:00	*********
15	*********	21	E	Course kk3kj	ENROLLED	11/6/2012 9:00	11/8/2012 18:00	*********
16	*********	21	E	Course kk3kj	CANCELLED	11/6/2012 9:00	11/8/2012 18:00	*********
report(3)

Output:

Excel 2010
	A	B	C	D	E	F	G	H	I	J	K	L
2	Course Number	Loc	Start Date	End date	Max	Total Reg	Cancel	Waitlist	Currently Enrolled	No Show	Walk-in	Final Participants
3	Course #mpkek234	A	12/3/2012	12/3/2012	30	2	1	0	1	0	0	1
4	Course #mpkek234	B	12/5/2012	12/6/2012	20	3	1	0	2	0	0	2
5	course 4k5jj3	C	11/5/2012	11/9/2012	40	4	2	1	1	0	0	1
6	Course kk3kj	D	10/18/2012	10/19/2012	40	2	0	2	0	0	0	0
7	Course kk3kj	E	3/12/2013	3/14/2013	25	4	1	0	3	0	0	3
Q1 FY13

 

[Leith Ross]

Hello sssb2000,

I have a few questions for you.

1. What are the rules for matching start and end dates/times?
2. When calculating Currently Enrolled, are Cancels and Waitlist subtracted from Total Reg?
3. When calculating Final Participants, are No Shows are subtracted and Walk-ins added?
4. If Quarter 1 is from Jan 01 to Mar 31 Then why does Q1 FY13 include December dates?

 

[sssb2000]

Hi Leith,

1. I have 4 quarters. The user should be able to assign the start end dates that would determine these quarterly dates somewhere in the spreadsheet. (for example in Sheet2A1:A2 would be start end dates for quarter 1). Ps. Times aren't important in the date fields....but i'm stuck with them as that's how the data's coming in.
2. No. Currently enrolled is coming from the Enrolled status of each of the raw data rows.
3. Yes
4. I was trying to make it easy by saying Jan1-march31 but i see that i confused you instead. sorry. please refer to my response in 1. in reality, these are FY quarters...

Hello sssb2000,

I have a few questions for you.

1. What are the rules for matching start and end dates/times?
2. When calculating Currently Enrolled, are Cancels and Waitlist subtracted from Total Reg?
3. When calculating Final Participants, are No Shows are subtracted and Walk-ins added?
4. If Quarter 1 is from Jan 01 to Mar 31 Then why does Q1 FY13 include December dates?

 

[Leith Ross]

Hello sssb2000,

That makes things clearer. I will write some macros based on your posted example. It would be better if I had more data to work with but this should work for a starting point.

 

[sssb2000]

Thank you so much!

Hello sssb2000,

That makes things clearer. I will write some macros based on your posted example. It would be better if I had more data to work with but this should work for a starting point.

 

[sssb2000]

is there anything else i can provide to make the creation of the VBA easier?

 

[sssb2000]

bump

 

[sssb2000]

Leith, any luck?
i can send a file to make it easier if that helps....

 

[Leith Ross]

Hello sssb2000,

I wanted this to be easy to use,to understand, and to work quickly. There are two main sheets named "RAW" and "Report". The raw data is copied to the "RAW" sheet. The macro uses the data in columns "N:S" starting at column 2 and down to the last entry of column "N". Once the data has been sorted, filtered, and consolidated, it it copied over to the "Report" sheet starting in cell "A2". Any previous data is cleared before the new report is copied to the worksheet. Let me know what you think.

There are four buttons on the "Report" sheet labeled "Q1", "Q2", "Q3", and "Q4". Clicking a button will consolidate the data for the calendar quarter shown on the button. if no data is found then the "Report" sheet will be blank. The macro shown here has been tested on the data you provided in the example you posted. Hopefully, this will little or no change to run correctly on the actual data.

Here is the link to the workbook...
Sorting and Consolidating Data

' http://www.mrexcel.com/forum/excel-questions/682241-sorting-consolidating-data-using-visual-basic-applications-second-attempt-please-help.html
' Written: January 30, 2013 for sssb2000
' Author:  Leith Ross

Sub Sample1()

    Dim Course As String
    Dim Data As Variant
    Dim DataRng As Range
    Dim Dict As Object
    Dim EndDate As Date
    Dim Location As Variant
    Dim Qfilter As Integer
    Dim r As Long
    Dim Rng As Range
    Dim RngEnd As Range
    Dim StartDate As Date
    Dim Status As String
    Dim Wks As Worksheet
    
        Set Wks = Worksheets("Raw")
        
        Set Rng = Wks.Range("N2:S2")
        Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
        If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Rng.Resize(RowSize:=RngEnd.Row - Rng.Row + 1)
    
        Wks.AutoFilterMode = False
        
        Wks.Sort.SortFields.Clear
        
        Application.ScreenUpdating = False
        
          ' Sort the Raw data by location and date.
            Rng.Sort _
                Key1:=Rng.Cells(1, 3), Order1:=xlAscending, _
                Key2:=Rng.Cells(1, 6), Order2:=xlAscending, _
                Header:=xlYes, MatchCase:=False, _
                Orientation:=xlTopToBottom, _
                DataOption1:=xlSortTextAsNumbers, _
                DataOption2:=xlSortTextAsNumbers
        
            Wks.Sort.Apply
            
         ' Choose the Quarter by which button was clicked.
            Select Case ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
                Case Is = "Q1": Qfilter = xlFilterAllDatesInPeriodQuarter1
                Case Is = "Q2": Qfilter = xlFilterAllDatesInPeriodQuarter2
                Case Is = "Q3": Qfilter = xlFilterAllDatesInPeriodQuarter3
                Case Is = "Q4": Qfilter = xlFilterAllDatesInPeriodQuarter4
            End Select
            
            Rng.AutoFilter 6, Qfilter, xlFilterDynamic
        
          ' Get the filter cells less the header row.
            Set DataRng = Rng.SpecialCells(xlCellTypeVisible)
            Set DataRng = Intersect(DataRng.Offset(1, 0), DataRng)
            
            Wks.AutoFilterMode = False
            
          ' Exit if there is no filtered data.
            If DataRng Is Nothing Then
                Worksheets("Report").UsedRange.Offset(1, 0).ClearContents
                Worksheets("Report").Activate
                Application.ScreenUpdating = True
                Exit Sub
            End If
            
            ReDim Data(10)
                
              ' Start consolidating the data.
              
                Set Dict = CreateObject("Scripting.Dictionary")
                Dict.CompareMode = vbTextCompare
                
                For Each Cell In DataRng.Columns(4).Cells
                    Status = UCase(Trim(Cell))
                    
                    If Status <> "" Then
                        Location = Cell.Offset(0, -2) & Cell.Offset(0, 1)
                        
                        If Not Dict.Exists(Location) Then
                            ReDim Data(10)
                            Data(0) = Cell.Offset(0, -1).Value  ' Course
                            Data(1) = Cell.Offset(0, -2).Value  ' Location
                            Data(2) = Cell.Offset(0, 1).Value   ' Start Date
                            Data(3) = Cell.Offset(0, 2).Value   ' End Date
                            Data(7) = 0                         ' Currently Enrolled
                            Dict.Add Location, Data
                        End If
                        
                        Data = Dict(Location)
                            
                        Select Case Status
                            Case Is = "ENROLLED":   Data(7) = Data(7) + 1
                            Case Is = "CANCELLED":  Data(5) = Data(5) + 1
                            Case Is = "WAITLIST":   Data(6) = Data(6) + 1
                            Case Is = "WALK-IN":    Data(9) = Data(9) + 1
                            Case Is = "NO SHOW":    Data(8) = Data(8) + 1
                        End Select
                        
                        Data(4) = Data(4) + 1                   ' Total Registered
                        Data(10) = Data(7) - Data(8) + Data(9)  ' Final Participants
                        
                        Dict(Location) = Data
                    End If
                Next Cell
                
      ' Copy the consolidateed data to the Report worksheet.
        
            Set Wks = Worksheets("Report")
            
            Wks.UsedRange.Offset(1, 0).ClearContents
            
            Set Rng = Wks.Range("A2").Resize(columnSize:=UBound(Data) + 1)
        
            For Each Location In Dict
                Rng.Offset(r, 0).Value = Dict(Location)
                r = r + 1
            Next Location
            
        Application.ScreenUpdating = True
        
        Wks.Activate
        
End Sub

 

[sssb2000]

Leith,
thank you so much!
when i enable macros and go to the report sheet and click on Q1, i get a VBA error:
Compile error:
Method or data member not found and it highlights: Wks.Sort.SortFields.Clear

Also, please take a look at my dummy file with a simple sample: dummy v2.xlsx


ps. i love mediafire!!!!
thanks!