Message box tweak

[stewart1]

Hi to all.

I have this code below which was given to me but I need to ammend it slightly.

This code works on four main columns. Column "A" is the log number, "G" is the date out, "J" is the comments box and "K" is the day counter (which has the formula =DATEDIF(G4,TODAY(),"d"). This counts the days for each date out in their respective rows).

Basically this code is abit "over zealous". Whilst I want the user to be reminded how many days have passed (over 11 to be precise) and to put a comment as to the reason why (it has not been returned*) I need the message box to cease if a date is entered in column "I" which is the "date returned*" column.

This workbook will have many entries put onto it and I would imagine the entire code would best be run once the user tries to close the workbook so as not to be deluged by the messagebox picking up every "overdue" issue whilst the user is trying to make a new entry.

Here is the code I have below. If someone can help, I would be extremely grateful.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lastrow As Long, icell As Long
Dim lognumber As String, Msg As String, Msg2 As String
Dim ibox As Variant
Dim Daycount As String

lastrow = Range("K" & Rows.Count).End(xlUp).Row

For icell = 2 To lastrow
    lognumber = Range("A" & icell).Value
    Daycount = Range("K" & icell).Value
If Range("K" & icell).Value > 11 Then
        Msg = MsgBox(Daycount & " days have now elapsed for log number " & lognumber & ", would you like to enter a comment now.", vbYesNo, "Error")
            If Msg = vbYes Then
                ibox = Application.InputBox("Please enter your comment in the box.", "Comments")
                    'err handling
                        If ibox = False Then
                           GoTo Nextone
                      ElseIf ibox = "" Then
                            Msg2 = MsgBox("You must enter a comment.", vbOK, "Error")
                           GoTo Nextone
                        End If
                    Range("J" & icell).Value = ibox
                    Range("K" & icell).Value = Daycount & " *"
            ElseIf Msg = vbNo Then
                'nothing
            End If
    End If
Nextone:
Next icell

End Sub

 

[stewart1]

Sorry for bumping folks but my thread got moved down so fast!

 

[stewart1]

Can anyone help with this or can it not be done? If it cannot could someone let me know please.

thanks

 

[jmthompson]

Untested, but try

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lastrow As Long, icell As Long
Dim lognumber As String, Msg As String, Msg2 As String
Dim ibox As Variant
Dim Daycount As String

lastrow = Range("K" & Rows.Count).End(xlUp).Row

For icell = 2 To lastrow
    lognumber = Range("A" & icell).Value
    Daycount = Range("K" & icell).Value
If Range("K" & icell).Value > 11 And Range("I" & icell)= "" Then
        Msg = MsgBox(Daycount & " days have now elapsed for log number " & lognumber & ", would you like to enter a comment now.", vbYesNo, "Error")
            If Msg = vbYes Then
                ibox = Application.InputBox("Please enter your comment in the box.", "Comments")
                    'err handling
                        If ibox = False Then
                           GoTo Nextone
                      ElseIf ibox = "" Then
                            Msg2 = MsgBox("You must enter a comment.", vbOK, "Error")
                           GoTo Nextone
                        End If
                    Range("J" & icell).Value = ibox
                    Range("K" & icell).Value = Daycount & " *"
            ElseIf Msg = vbNo Then
                'nothing
            End If
    End If
Nextone:
Next icell

End Sub

 

[stewart1]

jmthompson, it works!!!

Please can you tell me if I can make this macro effective as some sort of "beforeclose" so it doesn't bother the user trying to put in fresh data.

I can't believe you slipped that in and made that work!

Honest mate, sincere thanks, I'd shake your hand!

 

[jmthompson]

I've revised your code in a few ways.

1. It will auto run when the user clicks Save. (you need to put it in ThisWorkbook rather than the worksheet)

2. It will not replace any existing comments in column J, but append to them.

3. It will not replace the daycount formula in column K with the value

here is the code, you will need to change the sheets name referenced with the correct sheet:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets("Sheet1").Select
Dim lastrow As Long
Dim icell As Range
Dim lognumber As String, Msg As String, Msg2 As String
Dim ibox As Variant
Dim Daycount As String

lastrow = Range("K" & Rows.Count).End(xlUp).Row

For Each icell In Range("G2:G" & lastrow)
    lognumber = icell.Offset(, -6).Value
    Daycount = icell.Offset(, 4).Value
If icell.Value < Now() - 11 And icell.Offset(, 2) = "" Then

        Msg = MsgBox(Daycount & " days have now elapsed for log number " & lognumber & ", would you like to enter a comment now.", vbYesNo, "Error")
            If Msg = vbYes Then
                ibox = Application.InputBox("Please enter your comment in the box.", "Comments")
                    'err handling
                        If ibox = False Then
                           GoTo Nextone
                      ElseIf ibox = "" Then
                            Msg2 = MsgBox("You must enter a comment.", vbOK, "Error")
                           GoTo Nextone
                        End If
                    icell.Offset(, 3).Value = icell.Offset(, 3).Value & " " & Daycount & " day update- " & ibox
            ElseIf Msg = vbNo Then
                'nothing
            End If
    End If
Nextone:
Next icell
End Sub