VBA - How do we use Collection (or) Array to Generate report in excel sheet while it has activate,

R

riyajugen

New Member
Joined
Nov 10, 2020
Messages
9
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
We've to generate each individual report like Table 02 based on Branch in next sheet, using Table 01 Sheet (Sales) Table Data through VBA While Sheet(Report) Activate,

Table 01
DateBranchInvoice NoDelivery DateRiders NameAmountRemark
28/06/2020A253228/06/2020James$ 125.90
08/07/2020A265608/07/2020Fero$ 153.30
06/08/2020B253306/08/2020Gorge$ 180.70
15/09/2020A265715/09/2020Rico$ 208.10
05/10/2020B253405/10/2020Bolt$ 235.50
08/10/2020A265808/10/2020Fero$ 161.15
08/10/2020C253508/10/2020Fero$ 188.55
10/10/2020A265910/10/2020James$ 215.95
10/10/2020C253610/10/2020James$ 243.35
10/10/2020A254710/10/2020Fero$ 485.00
10/10/2020A524110/10/2020James$ 421.00
10/10/2020A524710/10/2020Gorge$ 421.00
13/10/2020B266013/10/2020Gorge$ 270.75
13/10/2020A253713/10/2020Gorge$ 298.15
17/10/2020A266117/10/2020Rico$ 325.55
17/10/2020B253817/10/2020Bolt$ 352.95
20/10/2020A266220/10/2020Fero$ 380.35
20/10/2020B253920/10/2020Gorge$ 388.20
22/10/2020A266322/10/2020Gorge$ 415.60
22/10/2020C254022/10/2020Gorge$ 443.00
22/10/2020A266422/10/2020Bolt$ 470.40
24/10/2020C254124/10/2020Fero$ 497.80
27/10/2020B266527/10/2020Bolt$ 525.20
04/11/2020A254204/11/2020Fero$ 552.60
30/11/2020B266630/11/2020Gorge$ 580.00

Table 02

ALL BRANCHBranch ABranch BBranch C
DateBranchRiders NameCountDateRiders NameCountDateRiders NameCountDateRiders NameCount
28/06/2020AJames128/06/2020James128/06/202028/06/2020
08/07/2020AFero108/07/2020Fero108/07/202008/07/2020
06/08/2020BGorge106/08/202006/08/2020Gorge106/08/2020
15/09/2020ARico115/09/2020Rico115/09/202015/09/2020
05/10/2020BBolt105/10/202005/10/2020Bolt105/10/2020
08/10/2020AFero208/10/2020Fero208/10/202008/10/2020
10/10/2020AJames210/10/2020James210/10/202010/10/2020
10/10/2020CJames110/10/202010/10/202010/10/2020James1
10/10/2020AFero110/10/2020Fero110/10/202010/10/2020
10/10/2020AGorge110/10/2020Gorge110/10/202010/10/2020
13/10/2020AGorge113/10/2020Gorge113/10/202013/10/2020
13/10/2020BGorge113/10/202013/10/2020Gorge113/10/2020
17/10/2020ARico117/10/2020Rico117/10/202017/10/2020
17/10/2020BBolt117/10/202017/10/2020Bolt117/10/2020
20/10/2020AFero120/10/2020Fero120/10/202020/10/2020
20/10/2020BGorge120/10/202020/10/2020Gorge120/10/2020
22/10/2020AGorge122/10/2020Gorge122/10/202022/10/2020
22/10/2020CRico122/10/202022/10/202022/10/2020Rico1
22/10/2020ABolt122/10/2020Bolt122/10/202022/10/2020
24/10/2020CFero124/10/202024/10/202024/10/2020Fero1
27/10/2020BBolt27/10/202027/10/2020Bolt27/10/2020
04/11/2020AFero104/11/2020Fero104/11/202004/11/2020
30/11/2020BGorge130/11/202030/11/2020Gorge130/11/2020
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
I don't quite understand what you what in terms of sourcing and output ranges so you'll have to edit those 2 lines yourself.
Also, assuming I understood the intent of what you wanted then a few of your numbers may be wrong.

VBA Code: 
Sub Create_Report()

Dim MainC As New Collection, Z As Long, INPT() As Variant, ALL_Branches As New Collection, OUT() As Variant, T As Long, _
L As Long, Name_Loop As Long, Branch_Loop As Long, New_Row As Long, Rider_Name As String, BR() As Variant, Date_Record As Date

INPT = ActiveSheet.UsedRange.Value

With ALL_Branches 'add all unique branches to the collection

    On Error Resume Next
    
    For Z = 2 To UBound(INPT, 1)
        .Add UCase(INPT(Z, 2)), UCase(INPT(Z, 2))
    Next Z
    
    ReDim BR(1 To 2, 1 To .Count) 'write unique items to array
    
    For Z = 1 To .Count
        BR(1, Z) = .ITEM(Z)
    Next Z
    
End With

With MainC

    For Z = 2 To UBound(INPT, 1)
        
        On Error Resume Next
        
            .Add New Collection, CStr(INPT(Z, 1)) 'Add date Collection if it doesn't exist
            
            Err.Number = 0
        
        With .ITEM(CStr(INPT(Z, 1))) 'with the date collection
        
            If .Count = 0 Then .Add INPT(Z, 1), "Date Record" 'add this first
            
            .Add New Collection, INPT(Z, 5) 'add another collection keyed to the person's name if it doesn't exist
            
            Err.Number = 0
            
            With .ITEM(INPT(Z, 5)) 'with the person add a collection of all unique branches if it doesn't exist
                
                If .Count = 0 Then
                    .Add INPT(Z, 5), "Name" 'add this first
                    
                    .Add BR, "Branch Array"
                    
                End If
                
                On Error GoTo 0
                
                OUT = .ITEM("Branch Array")
                
                L = Application.Match(UCase(INPT(Z, 2)), Application.Index(BR, 1, 0), 0)
                
                If OUT(2, L) = 0 Then T = T + 1    'will be used for sizing final array .increases if there is a new entry combo of date, branch and name

                OUT(2, L) = OUT(2, L) + 1 'update count
                
                .Remove "Branch Array"
                
                .Add OUT, "Branch Array"
                
            End With
            
        End With
        
    Next Z

End With

On Error GoTo 0

ReDim OUT(1 To T, 1 To (UBound(BR, 2) * 4) + 5)

With MainC
    
    New_Row = 0
    
    For T = 1 To .Count 'loop dates
    
        With .ITEM(T) 'Date Collection
        
            For Name_Loop = 2 To .Count 'names start at item 2
            
                Date_Record = .ITEM("Date Record")
                
                With .ITEM(Name_Loop) 'Name collection
                    
                    Rider_Name = .ITEM("Name")
                    
                    BR = .ITEM("Branch Array")
                    
                    For Branch_Loop = 1 To UBound(BR, 2)
                        
                        If BR(2, Branch_Loop) > 0 Then
                            
                            New_Row = New_Row + 1
                            
                            For L = 6 To UBound(OUT, 2) Step 4 'Fill in the dates for the current row
                                OUT(New_Row, L) = Date_Record
                            Next L
                            
                            OUT(New_Row, 3) = Rider_Name
                            OUT(New_Row, 1) = Date_Record
                            OUT(New_Row, 2) = BR(1, Branch_Loop)
                            
                            OUT(New_Row, 7 + 4 * (Branch_Loop - 1)) = Rider_Name
                            
                            OUT(New_Row, 4) = BR(2, Branch_Loop)
                            
                            OUT(New_Row, 8 + 4 * (Branch_Loop - 1)) = BR(2, Branch_Loop)
                            
                        End If
                        
                    Next Branch_Loop

                End With
                
           Next Name_Loop
           
        End With
        
    Next T
        

End With

ActiveSheet.Range("I1").Resize(UBound(OUT, 1), UBound(OUT, 2)) = OUT

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Excel Formula to highlight most recent record
Replies
3
Views
405
etaf
etaf
M
  • Solved
Formula Help.
Replies
3
Views
437
Fluff
Fluff
D
  • Solved
Chart Help Please
Replies
1
Views
106
dmj120
D
M
  • Solved
Get result based on dates and assumption
Replies
8
Views
252
Muthukrishnan V
M
S
  • Solved
Count of active employees between dates.
Replies
3
Views
666
Fluff
Fluff

Forum statistics

Threads
1,223,894
Messages
6,175,252
Members
452,623
Latest member
Techenthusiast

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