Identify sales made and return how many per employee and a cumulative total of the sales

[KOTRHR]

Dear all,

I wonder if anyone could please assist with something that I'm not entirely sure is possible. Admittedly this is just a "for fun" problem as it is for payroll for a company in a game so I won't be offended if no one is able to/willing to answer when there are other people with important questions, I just like to do this kind of thing as a learning experience.

As you can see per the screenshot attached, we generate a report that lists an employee's name along with the name of the person who the goods were sold to and on the next row down the dollar amount they were sold for.

Amongst these entries we also have the times that staff clocked in and out.

My question is thus:

Is there a way to count the times that each employee has made a sale and then separately, in another column total their sales, whilst ignoring entries that show their clocking in and out? Manually doing it is an option but with over 1000 "entries" a week it is a tedious process that takes several hours.

Your kind assistance is much appreciated.

 

[DacEasy]

Hi, I tried to come up with a solution. It isn't clear if these are two man team but I treated them as such. Just reply and I will take another look at it.

Sub forBuildSalesReport()
Application.DisplayAlerts = False
    
    For Each Sheet In ActiveWorkbook.Worksheets 'Using a new sheet to perform the calculations
        If Sheet.Name = "ReportZ" Then
            Sheet.Delete
        End If
    Next Sheet
    Sheets.Add After:=Sheets(Sheets.count)
    ActiveSheet.Name = "ReportZ"
   
    Sheet1.Select: Columns("A:A").Select: Selection.Copy 'Pasting Original data to sheet ReportZ
    Sheets("ReportZ").Select: ActiveSheet.Paste
    
    Dim lastRow As Long: Dim blastRow As Long
    
    'Find the lastRow
    With ActiveSheet
        lastRow = .UsedRange.Rows.count + .UsedRange.Row - 1
    End With
    
    Dim cell As Range
    For Each cell In Range("A1:A" & lastRow) 'Cleaning the data(removing minutes and dates)
        If InStr(cell.Value, "minutes") > 0 Then
            cell.Value = ""
        End If
        
        If InStr(cell.Value, "/") > 0 Then
            cell.Value = ""
        End If
        
        If cell.Value Like "*[a-zA-Z]*" Then 'Placing the Names in Column B
            cell.Offset(0, 1).Value = cell.Value
        End If
    Next cell
        
    ActiveSheet.Range("B1:B" & lastRow).RemoveDuplicates Columns:=1, Header:=Name 'Remove duplicate names
    
    Worksheets("ReportZ").Sort.SortFields.Clear 'Sort by names - Column B
    Range("B1:B" & lastRow).Sort Key1:=Range("B1"), Header:=xlNo
    
    Dim i As Long: Dim j As Long
    Dim count As Long: Dim salesTotal As Long
    
    count = 0
    salesTotal = 0
    blastRow = Cells(Rows.count, 2).End(xlUp).Row 'Find the lastrow of Column B

    For i = 1 To blastRow
        For j = 1 To lastRow
            If Range("B" & i) = Range("A" & j) Then                                         'Name in B and A match
                If Application.WorksheetFunction.IsNumber(Range("A" & j + 1)) = True Then   'look 1 row below
                    count = count + 1                                                       'increase the sales count
                    salesTotal = salesTotal + Range("A" & j + 1)                            'add to the sales total
                End If
                                                  
                If Application.WorksheetFunction.IsNumber(Range("A" & j + 2)) = True Then   ' or look 2 rows below
                    count = count + 1                                                       'increase the sales count
                    salesTotal = salesTotal + Range("A" & j + 2)                            'add to the sales total
                End If
            End If
        Next j
        
        Range("C" & i).Value = salesTotal 'Fill in the Sales Total
        Range("D" & i).Value = count 'Fill in Sales Count
        count = 0 'Reset for next name
        salesTotal = 0 'Reset for next name
    Next i
    
    Range("B1:D1").Select 'General cleanup, add column headers, format for currency
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
    End With
    
    Range("B1").Select:     ActiveCell.FormulaR1C1 = "Name"
    Range("C1").Select:     ActiveCell.FormulaR1C1 = "Sales Total"
    Range("D1").Select:     ActiveCell.FormulaR1C1 = "Sales Count"
   
    Columns("B:D").EntireColumn.AutoFit
    Columns("C:C").Select
    Selection.Style = "Currency"
    Range("A1").Select
    
    Sheet1.Select: Columns("A:A").Select: Selection.Copy 'Pasting Original data back to ReportZ
    Sheets("ReportZ").Select: ActiveSheet.Paste

Application.DisplayAlerts = True
End Sub

 

[KOTRHR]

Thank you for your response on this, I have to admit I am ashamedly poor with VBA and wouldn't have known where to begin. Unfortunately the number of employees varies on a day-to-day basis but hovers at approx. 30, is this too many to include in the script?

 

[DacEasy]

I hope it works but if columns b, c, and d are desired results, the size of column A shouldn't matter. But if there are teams of 3 or more people, then we may have to add code to handle or improve the code.

 

[KOTRHR]

Apologies if I was unclear; the first name of each section i.e. rows 1, 6, 11, etc. is the employee the second name (rows 2, 7, 12, etc.) is the purchaser and therefore is irrelevent. I just need it to count how many sales "x" employee (1, 6, 11, etc.) has made and their respective cumulative total (in this case 8, 23, 28 ignoring it if it is a non-dollar value).

With kind regards,
Martin.

 

[DacEasy]

Ok, I will modify the code to remove the purchaser.

 

[DacEasy]

Ok this will only pull the employees, the count, and total sales. Enjoy man.

Sub forBuildSalesReport()
Application.DisplayAlerts = False
    
    For Each Sheet In ActiveWorkbook.Worksheets 'Using a new sheet to perform the calculations
        If Sheet.Name = "ReportZ" Then
            Sheet.Delete
        End If
    Next Sheet
    Sheets.Add After:=Sheets(Sheets.count)
    ActiveSheet.Name = "ReportZ"
   
    Sheet1.Select: Columns("A:A").Select: Selection.Copy 'Pasting Original data to sheet ReportZ
    Sheets("ReportZ").Select: ActiveSheet.Paste
    
    Dim lastRow As Long: Dim blastRow As Long
    
    'Find the lastRow
    With ActiveSheet
        lastRow = .UsedRange.Rows.count + .UsedRange.Row - 1
    End With
    
    Dim cell As Range
    For Each cell In Range("A1:A" & lastRow) 'Cleaning the data(removing minutes and dates)
        If InStr(cell.Value, "minutes") > 0 Then
            cell.Value = ""
        End If

        If InStr(cell.Value, "/") > 0 Then
            cell.Value = ""
        End If

        If cell.Value Like "*[a-zA-Z]*" Then 'Placing the Names in Column B
            cell.Offset(0, 1).Value = cell.Value
        End If
    Next cell
        
    ActiveSheet.Range("B1:B" & lastRow).RemoveDuplicates Columns:=1, Header:=Name 'Remove duplicate names
    
    Dim i As Long: Dim j As Long
    Dim count As Long: Dim salesTotal As Long
    
    count = 0
    salesTotal = 0
    blastRow = Cells(Rows.count, 2).End(xlUp).Row 'Find the lastrow of Column B

    For i = 1 To blastRow
        For j = 1 To lastRow
            If Range("B" & i) = Range("A" & j) Then
                If Application.WorksheetFunction.IsNumber(Range("A" & j + 2)) = True Then   'look 2 rows below
                    count = count + 1                                                       'increase the sales count
                    salesTotal = salesTotal + Range("A" & j + 2)                            'add to the sales total
                End If
            End If
        Next j
        Range("C" & i).Value = salesTotal 'Fill in the Sales Total
        Range("D" & i).Value = count 'Fill in Sales Count
        count = 0 'Reset for next name
        salesTotal = 0 'Reset for next name
        If Range("D" & i).Value = 0 Then
            Range("B" & i).Value = ""
            Range("C" & i).Value = ""
            Range("D" & i).Value = ""
        End If
    Next i
    
    Worksheets("ReportZ").Sort.SortFields.Clear 'Sort by names - Column B
    Range("B1:D" & lastRow).Sort Key1:=Range("B1"), Header:=xlNo
    
    Range("B1:D1").Select 'General cleanup, add column headers, format for currency
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
    End With
    
    Range("B1").Select:     ActiveCell.FormulaR1C1 = "Name"
    Range("C1").Select:     ActiveCell.FormulaR1C1 = "Sales Total"
    Range("D1").Select:     ActiveCell.FormulaR1C1 = "Sales Count"
   
    Columns("B:D").EntireColumn.AutoFit
    Columns("C:C").Select
    Selection.Style = "Currency"
    Range("A1").Select
    
    Sheet1.Select: Columns("A:A").Select: Selection.Copy 'Pasting Original data back to ReportZ
    Sheets("ReportZ").Select: ActiveSheet.Paste

Application.DisplayAlerts = True
End Sub

 

[KOTRHR]

Thank you very much! That's extremely kind of you, I'm in awe of your intellect.

 

[KOTRHR]

Ok this will only pull the employees, the count, and total sales. Enjoy man.

Sub forBuildSalesReport()
Application.DisplayAlerts = False
   
    For Each Sheet In ActiveWorkbook.Worksheets 'Using a new sheet to perform the calculations
        If Sheet.Name = "ReportZ" Then
            Sheet.Delete
        End If
    Next Sheet
    Sheets.Add After:=Sheets(Sheets.count)
    ActiveSheet.Name = "ReportZ"
  
    Sheet1.Select: Columns("A:A").Select: Selection.Copy 'Pasting Original data to sheet ReportZ
    Sheets("ReportZ").Select: ActiveSheet.Paste
   
    Dim lastRow As Long: Dim blastRow As Long
   
    'Find the lastRow
    With ActiveSheet
        lastRow = .UsedRange.Rows.count + .UsedRange.Row - 1
    End With
   
    Dim cell As Range
    For Each cell In Range("A1:A" & lastRow) 'Cleaning the data(removing minutes and dates)
        If InStr(cell.Value, "minutes") > 0 Then
            cell.Value = ""
        End If

        If InStr(cell.Value, "/") > 0 Then
            cell.Value = ""
        End If

        If cell.Value Like "*[a-zA-Z]*" Then 'Placing the Names in Column B
            cell.Offset(0, 1).Value = cell.Value
        End If
    Next cell
       
    ActiveSheet.Range("B1:B" & lastRow).RemoveDuplicates Columns:=1, Header:=Name 'Remove duplicate names
   
    Dim i As Long: Dim j As Long
    Dim count As Long: Dim salesTotal As Long
   
    count = 0
    salesTotal = 0
    blastRow = Cells(Rows.count, 2).End(xlUp).Row 'Find the lastrow of Column B

    For i = 1 To blastRow
        For j = 1 To lastRow
            If Range("B" & i) = Range("A" & j) Then
                If Application.WorksheetFunction.IsNumber(Range("A" & j + 2)) = True Then   'look 2 rows below
                    count = count + 1                                                       'increase the sales count
                    salesTotal = salesTotal + Range("A" & j + 2)                            'add to the sales total
                End If
            End If
        Next j
        Range("C" & i).Value = salesTotal 'Fill in the Sales Total
        Range("D" & i).Value = count 'Fill in Sales Count
        count = 0 'Reset for next name
        salesTotal = 0 'Reset for next name
        If Range("D" & i).Value = 0 Then
            Range("B" & i).Value = ""
            Range("C" & i).Value = ""
            Range("D" & i).Value = ""
        End If
    Next i
   
    Worksheets("ReportZ").Sort.SortFields.Clear 'Sort by names - Column B
    Range("B1:D" & lastRow).Sort Key1:=Range("B1"), Header:=xlNo
   
    Range("B1:D1").Select 'General cleanup, add column headers, format for currency
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
    End With
   
    Range("B1").Select:     ActiveCell.FormulaR1C1 = "Name"
    Range("C1").Select:     ActiveCell.FormulaR1C1 = "Sales Total"
    Range("D1").Select:     ActiveCell.FormulaR1C1 = "Sales Count"
  
    Columns("B:D").EntireColumn.AutoFit
    Columns("C:C").Select
    Selection.Style = "Currency"
    Range("A1").Select
   
    Sheet1.Select: Columns("A:A").Select: Selection.Copy 'Pasting Original data back to ReportZ
    Sheets("ReportZ").Select: ActiveSheet.Paste

Application.DisplayAlerts = True
End Sub

I wonder where I am going wrong, when I try it, all it does it shows this:

Noodle King Payroll.xlsm
	A	B	C	D
1	Flora Puddin	Name	Sales Total	Sales Count
2	Flora Puddin
3	$4000
4	3/17/2022 05:08
5
6	Robert Davis
7	Terry Cortana
8	$8000
9	3/17/2022 11:36
10
11	Robert Davis
12	Jason Corolado
13	$7600
14	3/17/2022 11:38
15
16	Robert Davis
17	Dashaun Herbo
18	$8000
19	3/17/2022 11:41
20
21	Jorge Jung
22	Liam Peterson
23	$3500
24	3/17/2022 11:53
25
26	Robert Davis
27	3/17/2022 11:36
28	3/17/2022 11:53
29	18 minutes
30
31	Robert Davis
32	Swisha Jones
33	$16000
34	3/17/2022 11:57
35
36	Jorge Jung
37	Deebo Carter
38	$3500
39	3/17/2022 12:04
40
41	Robert Davis
42	3/17/2022 11:54
43	3/17/2022 12:11
44	18 minutes
45
46	Robert Davis
47	Robert Davis
48	$3500
49	3/17/2022 12:11
50
51	Jorge Jung
52	3/17/2022 11:49
53	3/17/2022 12:16
54	28 minutes
55
56	Jorge Jung
57	3/17/2022 12:16
58	3/17/2022 12:16
59	1 minutes
60
61	Jorge Jung
62	Jorge Jung
63	$8000
64	3/17/2022 12:17
65
66	Martin Wright
67	Bobbi Macintosh
68	$1200
69	3/17/2022 19:38
70
71	Martin Wright
72	Wanda Swift
73	$4000
74	3/17/2022 19:39
75
76	Martin Wright
77	Roger Carp
78	$6000
79	3/17/2022 19:40
80
81	Martin Wright
82	Noah Adam
83	$6000
84	3/17/2022 19:41
85
86	Martin Wright
87	Ben Burks
88	$800
89	3/17/2022 19:46
ReportZ

 

[DacEasy]

It's working on my end. Look at the vba editor, make sure there are no breaks in the code. Maybe supply a screenshot of the VBA editor, because it seems like you only have part of code pasted in. I ran into an issue this morning where the person only pasted part of the code so they were not seeing the desired results also.