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]

Ok, I remade with just For Loops, try now:

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

 

[KOTRHR]

Ok, I remade with just For Loops, try now:

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]

Maybe this version, the "$" plays a role:

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