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

KOTRHR

New Member
Joined
Mar 15, 2022
Messages
11
Office Version
  1. 365
Platform
  1. Web
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.
 

Attachments

  • Capture.PNG
    Capture.PNG
    64 KB · Views: 15

DacEasy

Board Regular
Joined
Jan 5, 2022
Messages
114
Office Version
  1. 2010
  2. 2007
  3. 2003 or older
Platform
  1. Windows
Ok, I remade with just For Loops, try now:

VBA Code:
Option Explicit
Sub forBuildSalesReport()
Application.DisplayAlerts = False
    Dim Sheet As Worksheet
    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 rA
    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:=xlNo  'Remove duplicate names
    
    Dim i As Long: Dim j As Long
    Dim count As Long: Dim salesTotal As Long
    
    For i = 1 To lastRow - 3
        If Range("A" & i).Value > 0 Then
            If Range("A" & i + 2).Value = "" And Range("A" & i + 3).Value = "" Then
                Range("A" & i).Value = ""
            End If
        End If
    Next i
    
    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).Value = Range("A" & j).Value Then
                If Range("A" & j).Value = "" Then
                    GoTo blanks
                Else
                    count = count + 1                                                       'increase the sales count
                    salesTotal = salesTotal + Range("A" & j + 2)                            'add to the sales total
                End If
blanks:
            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("C" & 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
 
Solution

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

KOTRHR

New Member
Joined
Mar 15, 2022
Messages
11
Office Version
  1. 365
Platform
  1. Web
Ok, I remade with just For Loops, try now:

VBA Code:
Option Explicit
Sub forBuildSalesReport()
Application.DisplayAlerts = False
    Dim Sheet As Worksheet
    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 rA
    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:=xlNo  'Remove duplicate names
   
    Dim i As Long: Dim j As Long
    Dim count As Long: Dim salesTotal As Long
   
    For i = 1 To lastRow - 3
        If Range("A" & i).Value > 0 Then
            If Range("A" & i + 2).Value = "" And Range("A" & i + 3).Value = "" Then
                Range("A" & i).Value = ""
            End If
        End If
    Next i
   
    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).Value = Range("A" & j).Value Then
                If Range("A" & j).Value = "" Then
                    GoTo blanks
                Else
                    count = count + 1                                                       'increase the sales count
                    salesTotal = salesTotal + Range("A" & j + 2)                            'add to the sales total
                End If
blanks:
            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("C" & 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
Thank you so much, I had to get rid of the "$" from the amounts but that is simple to do (even for me) and it works... You're amazing... Thank you so much!
 

DacEasy

Board Regular
Joined
Jan 5, 2022
Messages
114
Office Version
  1. 2010
  2. 2007
  3. 2003 or older
Platform
  1. Windows
Maybe this version, the "$" plays a role:

VBA Code:
Option Explicit

Sub tester()
Application.DisplayAlerts = False
   
    Dim lastRow As Long, i, Sheet As Worksheet
    Dim cell As Range, MyRg1 As Range, MyRg2 As Range
   
    For Each Sheet In ActiveWorkbook.Worksheets 'Use 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
   
    lastRow = Cells(Rows.count, "A").End(xlUp).Row 'Find the lastRow
   
    For Each cell In Range("A1:A" & lastRow) 'Locate cells with $ sign and the name 2 rows above
        i = cell.NumberFormat
        If InStr(i, "$") > 0 Then
            cell.Offset(0, 2).Value = cell.Offset(-2, 0).Value  'Place name in column C
            cell.Offset(0, 3).Value = cell.Value                'Place amount in column D
        End If
    Next cell
   
    For i = 1 To lastRow
        Set MyRg1 = Range("C1:C" & lastRow)
        Set MyRg2 = Range("D1:D" & lastRow)
        Cells(i, "D") = WorksheetFunction.SumIf(MyRg1, (Range("C" & i)), MyRg2) 'Sum based on name
        Cells(i, "E") = WorksheetFunction.CountIf(MyRg1, (Range("C" & i)))      'Count based on name
    Next i
   
    Set MyRg1 = Range("C1:E" & lastRow)
    MyRg1.RemoveDuplicates Columns:=1, Header:=xlNo
   
    Range("C1").Select:     ActiveCell.FormulaR1C1 = "Name"
    Range("D1").Select:     ActiveCell.FormulaR1C1 = "Sales Total"
    Range("E1").Select:     ActiveCell.FormulaR1C1 = "Sales Count"
  
    Columns("B:E").EntireColumn.AutoFit
   
    Sheet1.Select: Columns("A:A").Copy Sheets("ReportZ").Range("A1")

    Sheets("ReportZ").Select: Range("A1").Select

Application.DisplayAlerts = True
End Sub
 

Forum statistics

Threads
1,181,228
Messages
5,928,770
Members
436,628
Latest member
Krakenfan69

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