Need macro to look for person's name and specific date, then count values in an array

R

Reiper79

New Member
Joined
Jun 15, 2021
Messages
19
Office Version
  1. 365
Platform
  1. Windows
Hi Folks,

Can someone please help me out here?

Say I have an excel sheet that looks like this:

TrainerSiteVOC 1VOC 2VOC 3VOC 4VOC 5VOC 6VOC 7VOC 8VOC 9VOC 10VOC 11
Name 1Site 115/09/202115/09/2021
Name 1Site 114/09/202117/08/2021
Name 1Site 1114/09/2021
Name 1Site 620/09/2021
Name 10Site 1009/09/202107/09/2021
Name 10Site 1526/08/2021
Name 10Site 503/08/202103/08/2021
Name 2Site 1227/09/2021
Name 2Site 224/09/202124/09/202124/09/202124/09/202124/09/202124/09/2021
Name 2Site 217/08/2021
Name 2Site 726/08/2021
Name 3Site 1328/08/2021
Name 3Site 327/08/2021
Name 3Site 327/08/2021
Name 3Site 811/08/202111/08/202111/08/202111/08/202111/08/2021
Name 4Site 1419/08/2021
Name 4Site 421/09/202121/09/2021
Name 4Site 420/08/202120/08/202120/08/202120/08/202120/08/2021
Name 4Site 903/09/2021
Name 5Site 1020/09/2021
Name 5Site 1504/08/2021
Name 5Site 511/08/202111/08/202111/08/202111/08/202111/08/2021
Name 5Site 527/08/202127/08/202127/08/2021
Name 6Site 126/08/2021
Name 6Site 1121/09/2021
Name 6Site 619/08/202119/08/202119/08/202119/08/2021
Name 6Site 627/08/202127/08/202127/08/202127/08/2021
Name 7Site 1226/08/2021
Name 7Site 224/08/202124/08/202124/08/202124/08/202124/08/2021
Name 7Site 731/08/2021
Name 7Site 720/09/2021
Name 8Site 1319/08/2021
Name 8Site 325/08/2021
Name 8Site 822/09/2021
Name 8Site 821/09/202121/09/202121/09/2021
Name 9Site 1409/09/2021
Name 9Site 414/09/2021
Name 9Site 927/08/2021
Name 9Site 912/08/2021

I need a macro that can look through the above table, count the number of VOCs performed per trainer per date, then add a row and paste the details in another sheet that looks similar to the below:

DateTrainerCategory 1 (VOC 1)Category 2 (VOC 2)Category 3 (VOC 3)Category 4 (VOC 4+5+6)Category 5 (VOC 7)Category 6 (VOC 8+9+10)Category 7 (VOC 11)
15/09/2021Name 11100000
14/09/2021Name 10020000
20/09/2021Name 11000000
17/08/2021Name 10000010
09/09/2021Name 100100100
07/09/2021Name 100001000
26/08/2021Name 101000000
03/08/2021Name 100000011
09/09/2021Name 90100000
14/09/2021Name 91000000

Is that possible?
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
How do you organized the summary on the other sheet? It is neither in date order nor name order.
 
Upvote 0
Hi Zot,

It doesn't need to be in order. I can always filter it later, if need be.

I just need the information gathered from the first sheet, then rows created in the second sheet and the gathered information pasted in the correct columns.

Thanks.
 
Upvote 0
Sorry. Got tied up. Try this
VBA Code: 
Sub Trainer()

Dim n As Long
Dim strCell As String
Dim key As Variant
Dim Vcell As Range, rngTrainer As Range
Dim Hcell As Range, rngVOC As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Dim dictDT As Object

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

Set dictDT = CreateObject("Scripting.Dictionary")

Set rngTrainer = ws1.Range("A2", ws1.Cells(Rows.Count, "A").End(xlUp))

For Each Vcell In rngTrainer
    Set rngVOC = ws1.Range("C" & Vcell.Row, "M" & Vcell.Row)
    For Each Hcell In rngVOC
        If Not Hcell = "" Then
            strCell = Hcell.Text & "," & Vcell.Value
        End If
        If Not dictDT.Exists(strCell) Then dictDT.Add strCell, Nothing
    Next
Next

n = 1
For Each key In dictDT
    n = n + 1
    ws2.Range("A" & n).NumberFormat = "d/m/yyyy"
    ws2.Range("A" & n) = DateValue(Split(key, ",")(0))
    ws2.Range("B" & n) = Split(key, ",")(1)
    For Each Vcell In rngTrainer
        If Vcell = ws2.Range("B" & n) Then
            Set rngVOC = ws1.Range("C" & Vcell.Row, "M" & Vcell.Row)
            For Each Hcell In rngVOC
                If Hcell.Value = ws2.Range("A" & n) Then
                    Select Case ws1.Cells(1, Hcell.Column)
                        Case "VOC 1"
                            ws2.Range("C" & n) = ws2.Range("C" & n) + 1
                        Case "VOC 2"
                            ws2.Range("D" & n) = ws2.Range("D" & n) + 1
                        Case "VOC 3"
                            ws2.Range("E" & n) = ws2.Range("E" & n) + 1
                        Case "VOC 4", "VOC 5", "VOC 6"
                            ws2.Range("F" & n) = ws2.Range("F" & n) + 1
                        Case "VOC 7"
                            ws2.Range("G" & n) = ws2.Range("G" & n) + 1
                        Case "VOC 8", "VOC 9", "VOC 10"
                            ws2.Range("H" & n) = ws2.Range("H" & n) + 1
                        Case "VOC 11"
                            ws2.Range("I" & n) = ws2.Range("I" & n) + 1
                    End Select
                End If
            Next
        End If
    Next
Next

End Sub
 
Upvote 0
Thanks mate. All good. I'll let you know how it goes. Greatly appreciated.
 
Upvote 0
It seems to work great except for the below.

1633069412994.png
1633069447628.png
 
Upvote 0
All data like that or is it the first instance?

I tested it was okay with your sample data. Perhaps the date is not valid date format
 
Upvote 0
Sorry to be a pain, but I just noticed that some of the dates aren't showing properly in sheet 2 (e.g. 28/07/2021 instead of 27/08/2021).

Also, the counts don't seem to be correctly placed and/or missing.

NOTE: I've tweaked what you sent me to match my actual spreadsheet which has more columns in Sheet 1 (Matrix) than I gave in my example above. See below in case I've miscopied or mistyped something.

Sub Count_by_Date()

Dim n As Long
Dim strCell As String
Dim key As Variant
Dim Vcell As Range, rngTrainer As Range
Dim Hcell As Range, rngVOC As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Dim dictDT As Object

Set ws1 = ActiveWorkbook.Sheets("Matrix")
Set ws2 = ActiveWorkbook.Sheets("Count by Date")

Set dictDT = CreateObject("Scripting.Dictionary")

Set rngTrainer = ws1.Range("D2", ws1.Cells(Rows.Count, "D").End(xlUp))

For Each Vcell In rngTrainer
Set rngVOC = ws1.Range("E" & Vcell.Row, "U" & Vcell.Row)
For Each Hcell In rngVOC
If Not Hcell = "" Then
strCell = Hcell.Text & "," & Vcell.Value
End If
If Not dictDT.Exists(strCell) Then dictDT.Add strCell, Nothing
Next
Next

n = 1
For Each key In dictDT
n = n + 1
ws2.Range("A" & n).NumberFormat = "dd/mm/yyyy"
ws2.Range("A" & n) = DateValue(Split(key, ",")(0))
ws2.Range("B" & n) = Split(key, ",")(1)
For Each Vcell In rngTrainer
If Vcell = ws2.Range("B" & n) Then
Set rngVOC = ws1.Range("E" & Vcell.Row, "U" & Vcell.Row)
For Each Hcell In rngVOC
If Hcell.Value = ws2.Range("A" & n) Then
Select Case ws1.Cells(1, Hcell.Column)
Case "Induction / Onboarding"
ws2.Range("C" & n) = ws2.Range("C" & n) + 1
Case "Forklift"
ws2.Range("D" & n) = ws2.Range("D" & n) + 1
Case "Yard Truck / Tug"
ws2.Range("E" & n) = ws2.Range("E" & n) + 1
Case "Light Rigid", "Medium Rigid", "Heavy Rigid", "Heavy Combination", "Multi Combination", "Reversing", "Reversing Offset"
ws2.Range("F" & n) = ws2.Range("F" & n) + 1
Case "SPOT"
ws2.Range("G" & n) = ws2.Range("G" & n) + 1
Case "Prime Mover to Trailer", "A-Trailer to B-Trailer", "Ringfeder", "Dolly to Trailer", "Road Train Assembly"
ws2.Range("H" & n) = ws2.Range("H" & n) + 1
Case "Load Restraint"
ws2.Range("I" & n) = ws2.Range("I" & n) + 1
End Select
End If
Next
End If
Next
Next

End Sub
 
Upvote 0
You're right. It does work for the sample data I gave you. It must be something I've tweaked to match my actual spreadsheet.

Can you see anything I've mistyped?
Could it have anything to do with the number of columns or column names?
 
Upvote 0
Once the date is not read correctly, the count would be incorrect.

Working with date sometimes can be troublesome for me. When it is capture as text, then even if they look the same it will not match either. VBA also treat date in US format. So, working with British format can also be tricky. That is why converting into date serial is better before doing anything. I don't see any problem with modification since it is very straightforward.

The best is that you can use the XL2BB tool (the icon on the right most). It is an addin that you use to select range and capture to paste to reply. This way helpers will get actual sheet with even formula intact. When pasting the capture, it looks like junk. Click Preview to see actual output and click preview again to continue writing.

Or, can you just copy part of your original data that cause the problem?
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Having issues with a IF(MAX(INDEX formula returning Yes or No
Replies
3
Views
81
RoryA
RoryA
C
  • Solved
Extract Dates from 2 columns
Replies
2
Views
300
Peter_SSs
Peter_SSs
H
  • Solved
Search for topics based on their groups.
Replies
7
Views
132
Peter_SSs
Peter_SSs
D
  • Question
Shares Lot Remaining Formula
Replies
0
Views
199
dude6571
D
H
  • Question
using sorting and array to deal with big data for expected result
Replies
0
Views
66
Hasson
H

Forum statistics

Threads
1,214,622
Messages
6,120,576
Members
448,972
Latest member
Shantanu2024

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