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

sssb2000

Well-known Member
Joined
Aug 17, 2004
Messages
1,169
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
ANOPQRST
1xxxMaxLocationTitleStatusStart Date/TimeEnd Date/Timexxx
2*********30ACourse #mpkek234CANCELLED12/3/2012 8:0012/3/2012 12:00*********
3*********20ACourse #mpkek234ENROLLED12/3/2012 8:0012/3/2012 12:00*********
4*********40BCourse #mpkek234ENROLLED12/5/2012 8:0012/6/2012 12:00*********
5*********40BCourse #mpkek234ENROLLED12/5/2012 8:0012/6/2012 12:00*********
6*********40BCourse #mpkek234CANCELLED12/5/2012 8:0012/6/2012 12:00*********
7*********40Ccourse 4k5jj3CANCELLED11/5/2012 8:0011/9/2012 17:00*********
8*********40Ccourse 4k5jj3CANCELLED11/5/2012 8:0011/9/2012 17:00*********
9*********40Ccourse 4k5jj3ENROLLED11/5/2012 8:0011/9/2012 17:00*********
10*********40Ccourse 4k5jj3WAITLIST11/5/2012 8:0011/9/2012 17:00*********
11*********25DCourse kk3kjWAITLIST3/12/2013 9:003/14/2013 18:00*********
12*********25DCourse kk3kjWAITLIST3/12/2013 9:003/14/2013 18:00*********
13*********21ECourse kk3kjENROLLED11/6/2012 9:0011/8/2012 18:00*********
14*********21ECourse kk3kjENROLLED11/6/2012 9:0011/8/2012 18:00*********
15*********21ECourse kk3kjENROLLED11/6/2012 9:0011/8/2012 18:00*********
16*********21ECourse kk3kjCANCELLED11/6/2012 9:0011/8/2012 18:00*********
report(3)



Output:


Excel 2010
ABCDEFGHIJKL
2Course NumberLocStart DateEnd dateMaxTotal RegCancelWaitlistCurrently EnrolledNo ShowWalk-inFinal Participants
3Course #mpkek234A12/3/201212/3/2012302101001
4Course #mpkek234B12/5/201212/6/2012203102002
5course 4k5jj3C11/5/201211/9/2012404211001
6Course kk3kjD10/18/201210/19/2012402020000
7Course kk3kjE3/12/20133/14/2013254103003
Q1 FY13
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,874
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
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

Well-known Member
Joined
Aug 17, 2004
Messages
1,169
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

Well-known Member
Joined
Mar 17, 2008
Messages
1,874
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
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

Well-known Member
Joined
Aug 17, 2004
Messages
1,169
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

Well-known Member
Joined
Aug 17, 2004
Messages
1,169
is there anything else i can provide to make the creation of the VBA easier?
 

sssb2000

Well-known Member
Joined
Aug 17, 2004
Messages
1,169
Leith, any luck?
i can send a file to make it easier if that helps....
 

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,874
Office Version
  1. 2010
  2. 2007
Platform
  1. Windows
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

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

Well-known Member
Joined
Aug 17, 2004
Messages
1,169
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!
 
Last edited:

Forum statistics

Threads
1,186,146
Messages
5,956,195
Members
438,238
Latest member
a cow tent

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
Top