Posting "Name" in msg box instead of "you"

[dinesh2605]

Hi Friends,

I have a list of names in column "D".
From the below code,i need to replace the msgbox "you" with the resource name.

Current display :

MsgBox "You have entered less than 9 hours for below date".


Requirement eg :

Msgbox " John have entered less than 9 hours for below date"

"John" is one of the resource names in the colunm D.


PLEASE HELP>



--------------------------------------------------------------------------------------------------------------------------------------

For i = LBound(DateArray) + 1 To UBound(DateArray)
If DateArray(i) <> "" Then
If Application.WorksheetFunction.SumIf(DateRange, DateArray(i), DateRange.Offset(0, 1)) > 9 Then


MsgBox "You have entered more than 9 hours for below date" & vbNewLine & vbNewLine & DateArray(i) & vbNewLine & vbNewLine & "Please create new row with all the details add hours in overtime column"


ElseIf Application.WorksheetFunction.SumIf(DateRange, DateArray(i), DateRange.Offset(0, 1)) < 9 Then


MsgBox "You have entered less than 9 hours for below date" & vbNewLine & vbNewLine & DateArray(i) & vbNewLine & vbNewLine & "Please enter 9hrs for above date"


End If
End If
Next i

 

[L. Howard]

Try it like this.

Howard

MsgBox DateArray(i) & " have entered more than 9 hours for below date" & vbNewLine & vbNewLine & DateArray(i) & vbNewLine & vbNewLine & "Please create new row with all the details add hours in overtime column"

 

[dinesh2605]

Appreciate your help Howard...let me try this.

 

[L. Howard]

Actually I think I shot too much from the hip on that suggestion.

As I re look, I don't know where column D is. You might try offsetting from DateRange either left or right the number of columns from DateRange column to reach the value in column D.

MsgBox DateRange.Offset(, -4) & " have entered more than 9 hours for below date"... etc. for a four column offset to the left.

MsgBox DateRange.Offset(, 4) & " have entered more than 9 hours for below date"... etc. for a four column offset to the Right.

Adjusting the 4 to reach column D.

Howard

 

[AliGW]

Sorry for the pedantic OT post, but it should read "John HAS entered ...".

 

[dinesh2605]

Hi Howard,
Below is the snap of my sheet.
Hope this helps you in resolving.

msgbox"John has entered....."


A B C D E F G H I J K
Team WG Team lead ResourceName Stage Activity ID Date Hours Overtime Remarks

Testing x Mike John 2 Skilled K1 1/15/2017 10hrs 0 -

 

[L. Howard]

Post the entire code, from Sub to End Sub.

Howard

 

[dinesh2605]

Sorry Howard ...was out of town.

Is there a way where I can attach the entire excel macro file for your easy reference.

Thanks.

Option Explicit


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim LastRow As Integer
Dim LastRow_RICEF As Integer
Dim aCell As Range
Dim DateArray() As String
Dim DateRange As Range
Dim i As Integer, j As Integer

LastRow = Sheet3.Range("G1048576").End(xlUp).Row
Set DateRange = Sheet3.Range("H2:H" & LastRow)


LastRow_RICEF = Cells(Rows.Count, 5).End(xlUp).Row
For Each aCell In Range("F2:F" & LastRow_RICEF)

If aCell.Value = "DEV" Or aCell.Value = "Others" Or aCell.Value = "Quality Review" Or aCell.Value = "Change dump Analysis" Or aCell.Value = "Minor Change" Or aCell.Value = "CRs" Or aCell.Value = "Core" Or aCell.Value = "Assembly Testing" Then
If aCell.Next = "" Then
MsgBox "Please Enter appropriate RICEFW ID in " & "" & Application.WorksheetFunction.Substitute(aCell.Next.Address, "$", "")
Cancel = True
Exit For
End If
End If
Next

For Each aCell In Range("F2:F" & LastRow_RICEF)
If aCell.Value = "Wait Time" Or aCell.Value = "Others" Then
If aCell.Next.Next.Next.Next.Next = "" Then
MsgBox "Please Enter appropriate Remarks in " & "" & Application.WorksheetFunction.Substitute(aCell.Next.Next.Next.Next.Next.Address, "$", "")
Cancel = True
Exit For
End If
End If
Next

LastRow_RICEF = Cells(Rows.Count, 5).End(xlUp).Row
For Each aCell In Range("A1:A" & LastRow_RICEF)
If aCell.Value = "" Then
MsgBox "Please Enter appropriate Stream name in" & "" & Application.WorksheetFunction.Substitute(aCell.Address, "$", "") & vbNewLine & vbNewLine & "Please enter stream name else the sheet will not saved"
Cancel = True
Exit For
End If

Next



LastRow_RICEF = Cells(Rows.Count, 5).End(xlUp).Row
For Each aCell In Range("B1:B" & LastRow_RICEF)
If aCell.Value = "" Then
MsgBox "Please Enter Team name in" & "" & Application.WorksheetFunction.Substitute(aCell.Address, "$", "") & vbNewLine & vbNewLine & "Please enter team name else the sheet will not saved"
Cancel = True
Exit For
End If
Next


LastRow_RICEF = Cells(Rows.Count, 5).End(xlUp).Row
For Each aCell In Range("C1:C" & LastRow_RICEF)
If aCell.Value = "" Then
MsgBox "Please Enter Teamlead name in" & "" & Application.WorksheetFunction.Substitute(aCell.Address, "$", "") & vbNewLine & vbNewLine & "Please enter Team lead name else the sheet will not be saved "


Cancel = True
Exit For
End If
Next


LastRow_RICEF = Cells(Rows.Count, 5).End(xlUp).Row
For Each aCell In Range("D1:D" & LastRow_RICEF)
If aCell.Value = "" Then
MsgBox "Please Enter Enterprise ID in" & "" & Application.WorksheetFunction.Substitute(aCell.Address, "$", "") & vbNewLine & vbNewLine & "Please enter your Enterprise ID elase the sheet will not be saved"
Cancel = True
Exit For
End If

Next

'Load dates into array

ReDim DateArray(DateRange.Cells.Count - 1)
For i = 1 To DateRange.Cells.Count
DateArray(i - 1) = DateRange.Cells(i, 1)
Next i

'Remove duplicates

For i = LBound(DateArray) To UBound(DateArray)
For j = LBound(DateArray) To UBound(DateArray)
If j <> i Then
If DateArray(j) = DateArray(i) Then
DateArray(j) = ""
End If
End If
Next j
Next i

'Formula

For i = LBound(DateArray) + 1 To UBound(DateArray)
If DateArray(i) <> "" Then
If Application.WorksheetFunction.SumIf(DateRange, DateArray(i), DateRange.Offset(0, 1)) > 9 Then
MsgBox Cells(i, 4) & "You have entered more than 9 hours for below date" & vbNewLine & vbNewLine & DateArray(i) & vbNewLine & vbNewLine & "Please create new row with all the details add hours in overtime column"
ElseIf Application.WorksheetFunction.SumIf(DateRange, DateArray(i), DateRange.Offset(0, 1)) < 9 Then
MsgBox Cells(i, 4) & "You have entered less than 9 hours for below date" & vbNewLine & vbNewLine & DateArray(i) & vbNewLine & vbNewLine & "Please enter 9hrs for above date"
End If
End If
Next i

End Sub

 

[L. Howard]

You can post a Link to your workbook. Use one of the link utilities like Drop Box or others like it to post the link.

Attachments are not allowed.

In that post also include a summary of what you want to happen and where, referring to specific cells, rows, columns and sheets.

Howard

 

[L. Howard]

Before you post your link, try this.

For i = LBound(DateArray)... starts with 0 (zero) so we will set the first iRow to 2 and it will make the first MsgBox Cells(iRow, 4)... act like this MsgBox Cells(2, 4)... and correctly increment for the next i.

Howard

 'Formula
Dim iRow As Long    '// Move this to the top of you code with the other Dim statements

 For i = LBound(DateArray) To UBound(DateArray)
   iRow = i + 2
 
 If DateArray(i) <> "" Then

   If Application.WorksheetFunction.SumIf(DateRange, DateArray(i), DateRange.Offset(0, 1)) > 9 Then

      MsgBox Cells(iRow, 4) & " You have entered more than 9 hours for below date" & vbNewLine & vbNewLine & _
                                DateArray(i) & vbNewLine & vbNewLine & _
                                "Please create new row with all the details add hours in overtime column"
                                
    ElseIf Application.WorksheetFunction.SumIf(DateRange, DateArray(i), DateRange.Offset(0, 1)) < 9 Then

      MsgBox Cells(iRow, 4) & " You have entered less than 9 hours for below date" & vbNewLine & vbNewLine & _
                                DateArray(i) & vbNewLine & vbNewLine & _
                                "Please enter 9 hrs for above date"
   End If
 End If
 
 Next i