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.

 

[KOTRHR]

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.

Thank you - please see attached screenshot as requested.

I've no doubt I'm doing something painfully stupid wrong.

 

[DacEasy]

Hmmm, this is wild, you copied and pasted correctly. You are running Office365? Try adding Option Explicit at the top, maybe that will yield an error and lead us down a different path. See below:

Option Explicit
Sub forBuildSalesReport()
Application.DisplayAlerts = False

 

[KOTRHR]

Hmmm, this is wild, you copied and pasted correctly. You are running Office365? Try adding Option Explicit at the top, maybe that will yield an error and lead us down a different path. See below:

Option Explicit
Sub forBuildSalesReport()
Application.DisplayAlerts = False

Thanks for this: here is the error that returned:

 

[DacEasy]

Ok, this was great training man. Option Explicit is a lifesaver.

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 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
    
    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]

Ok, this was great training man. Option Explicit is a lifesaver.

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 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
   
    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

Thanks - for some reason the output is still the same. Am I doing it right by adding it as a module? When I run the script it doesn't return an error. Sorry for the trouble.

 

[DacEasy]

Yes, everything looks perfect. Try updating the end of the code to the below or even remove it:

    Sheet1.Select: Columns("A:A").Select: Selection.Copy 'Pasting Original data back to ReportZ
    Sheets("ReportZ").Select:
    Range("A1").Select
    ActiveSheet.Paste

Another option is to add breakpoints during the For loops to verify the variables are updating, plus you can watch as the spreadsheet is built. It could also be our versions of Excel.

 

[DacEasy]

No trouble, I am here to learn. Hopefully if we solve this, it may solve for others.

 

[KOTRHR]

No trouble, I am here to learn. Hopefully if we solve this, it may solve for others.

Thanks - I added the section to the end as suggested but still the same output. I am using Excel 365.

When I run it from the project module I get this error:

and then when I click Debug:

I'm not sure what you mean by break points, sorry... as I say I've essentially no knowledge of VBA

 

[DacEasy]

Click to the left of the link and it will add red dots to pause the code. But google vba breakpoints for a clear understanding. You can press F8 to slowly step throw the code to see what it's doing and how it's updating. I am beginning to think our versions of Excel are a mismatch.

 

[KOTRHR]

I think it might be something to do with 365 v 2010 Why do they have to make thing so difficult A shame I can't make it run as if it were a 2010 (or whatever version you're creating this on) file.

I wonder if you're able to upload your workbook and I can open it in compatibility mode?