VBA Message box to display column titles based upon totals

Hi there,

I have a spreadsheet that contains 9 employees, and their sales in thousands over a period of 10 years. Their total sales over the 10 year period are totaled at the bottom. What I am looking to do is have a message box that pops up and displays the names of the employees who have total sales over 500. So basically the code will look for values over 500 in the bottom row, and then take the corresponding names of the employees and display it in a single message box. I am new to VBA, and have Googled around on how to get started with this but I have not found anything. I have attached my worksheet below, any help is greatly appreciated.


Attachment 23081

Something like this maybe

Code:

---

Option Explicit

Const cThreshHold As Double = 500#

Sub TotalSales()

    Dim Employees As Range
    Dim iTotalRow As Long, iCol As Long
    Dim sMsg As String

    Set Employees = ActiveSheet.Range("D4").CurrentRegion
   
   
    With Employees
   
        sMsg = "Employees with Total Sales over " & Format(cThreshHold, "$#,##0") & vbCrLf & vbCrLf
       
        iTotalRow = .Rows.Count
   
        For iCol = 2 To .Columns.Count
            If .Cells(iTotalRow, iCol).Value > cThreshHold Then
                sMsg = sMsg & .Cells(1, iCol).Value & " --- " & Format(.Cells(iTotalRow, iCol).Value, "$#,##0") & vbCrLf
            End If
        Next iCol
    End With

    Call MsgBox(sMsg, vbInformation + vbOKOnly, "Total Sales")

End Sub

---

Hi all,

Assuming you have a fixed table "I mean a period of 10 years" and using it as is "D4:N15", you can try this code:

Code:

---

Option Explicit

Sub TotalSales()
    Dim MESG            ' a string to build the displayed message
    Dim Cell As Range
    Dim Nrow, Ncol      ' row a col of found name
   
    MESG = ""          ' Empty string
    For Each Cell In Sheet1.Range("E15:N15")            'Here the range of Totals values is E15 to N15 you can change it if you add an 11th year ;)
        If Cell.Value > 500 Then                        'You test the value of the cell
            Nrow = Cell.Row - 11                        'row of the cell containing the related name : 11 rows Up
            Ncol = Cell.Column                          'column of the cell containing the related name : same column. Now we have coordinates
            MESG = MESG & Sheet1.Cells(Nrow, Ncol) & " ---------> " & Cell.Value & " $" & vbCrLf    ' build the message
        End If
    Next
    MsgBox MESG

End Sub

---

Hope this helps.
Please forgive my bad english.

Regards

Thank you so much to both. Both sets of code seem to work great!

Hi, Trying to amend the code to include in the message box details of failed items.

So in the active column, I have some cells indicating "FAILED". in the adjacent columns, I have data in Column A and B. How will the below code be amended so it lists the corresponding data in Column A and B when the number of Failed items on the message box appears??

At the moment it indicates how many failed items in the active column, but I need to add to this and provide details what the failed items are from Column A and B.
Many thanks


Sub Messagebox1() Dim instances As Long instances = WorksheetFunction.CountIf(Columns(ActiveCell.Column), "FAILED") MsgBox "Found " & instances & " Failed Upload(s)", vbInformation, "TITLE"
End sub

1. It's not polite to hijack someone's thread with what seems to be a very different question using very different data (i.e. the OP's Employee Sales.xlsm workbook doesn't have any data in columns A and B, your 'active column' is not identified, and there are no FAILED in the OP's attached example)

2. This was marked [Solved]

3. You'll get much better results if you started your own thread and included a sample workbook that clearly show your data structure and the macro that you have a question about