VBA message amendment when result is less than 2

Ironman

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,069
Office Version
  1. 365
Platform
  1. Windows
Hi

The below code is perfect when the result is 2 or more, but looks clumsy when it's only 1.
VBA Code: 
MsgBox Format(Date, "dddd d mmmm, yyyy") & ":" & vbNewLine & vbNewLine _
         & "If you're going for a run today, then before this run:" & vbNewLine & vbNewLine _
         & "- You were " & CLng(Range("MilesToNextYearEndTotal")) & " miles behind the " & Range("PreYear") & " year end total" & vbNewLine & vbNewLine _
         & "- You were " & CLng(Abs(.Value)) & " miles behind the " & Year(Now) - 1 & " year to date total", vbInformation, "Miles Run YTD"
I'd be really grateful for an amendment to the above that changes the message from "miles" to "mile" when the value of CLng(Range("MilesToNextYearEndTotal")) or CLng(Abs(.Value)) is 1.

Many thanks!
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
How about ...

VBA Code: 
Sub Ironman()

    Dim AmountA As Long, AmountB As Long
    Dim TextA As String, TextB As String, Msg As String

    Msg = "If you're going for a run today, then before this run:" & vbNewLine & vbNewLine & _
          "- You were @A@ behind the " & Range("PreYear") & " year end total" & vbNewLine & vbNewLine & _
          "- You were @B@ behind the " & Year(Now) - 1 & " year to date total"

    AmountA = CLng(Range("MilesToNextYearEndTotal"))
    AmountB = CLng(Abs(.Value))
    TextA = AmountA & " mile":  If AmountA > 1 Then TextA = TextA & "s"
    TextB = AmountB & " mile":  If AmountB > 1 Then TextB = TextB & "s"

    Msg = VBA.Replace(Msg, "@A@", AmountA)
    Msg = VBA.Replace(Msg, "@B@", AmountB)

    MsgBox Format(Date, "dddd d mmmm, yyyy") & ":" & vbNewLine & vbNewLine & Msg, vbInformation, "Miles Run YTD"
End Sub
 
Upvote 0
Many thanks GWteB - I tried adapting my code to fit yours but it returned "1" without the "mile" (and for the other message, "11" without the "miles").

Here's the complete code:
VBA Code: 
Dim A As Integer

A = Sheets("Daily Tracking").Range("CG375").Value Mod 1000

If 1000 - A <= 100 Then MsgBox 1000 - A & " miles to go until you reach " & Format(Range("CG375").Value + 1000 - A, "#,##0"), vbInformation, "1,000 Mile Countdown"
If A > 0 And A <= 10 Then MsgBox "Congratulations! You have now run over " & Format(Range("CG375").Value - A, "#,##0") & " miles", vbInformation, "1,000 Mile Countdown"

Dim AmountA As Long, AmountB As Long
Dim TextA As String, TextB As String, Msg As String
   With Sheets("Training Log").Range("E5")
      Select Case .Value
         
         Case Is < 0: 'YTD mlg less than this time last year
         Msg = "If you're going for a run today, then before this run:" & vbNewLine & vbNewLine & _
          "- You were @A@ behind the " & Range("PreYear") & " year end total" & vbNewLine & vbNewLine & _
          "- You were @B@ behind the " & Year(Now) - 1 & " year to date total"

         AmountA = CLng(Range("MilesToNextYearEndTotal"))
         AmountB = CLng(Abs(.Value))
         TextA = AmountA & " mile":  If AmountA > 1 Then TextA = TextA & "s"
         TextB = AmountB & " mile":  If AmountB > 1 Then TextB = TextB & "s"

         Msg = VBA.Replace(Msg, "@A@", AmountA)
         Msg = VBA.Replace(Msg, "@B@", AmountB)

         MsgBox Format(Date, "dddd d mmmm, yyyy") & ":" & vbNewLine & vbNewLine & Msg, vbInformation, "Miles Run YTD"
         
         Case 0: 'YTD mlg the same as this time last year
         Msg = "If you're going for a run today, then before this run:" & vbNewLine & vbNewLine & _
          "- You had @A@ to beat the " & Range("PreYear") & " year end total" & vbNewLine & vbNewLine & _
          "- You had @B@ to beat the " & Year(Now) - 1 & " year to date total"

         AmountA = CLng(Range("MilesToNextYearEndTotal"))
         AmountB = CLng(Abs(.Value))
         TextA = AmountA & " mile":  If AmountA > 1 Then TextA = TextA & "s"
         TextB = AmountB & " mile":  If AmountB > 1 Then TextB = TextB & "s"

         Msg = VBA.Replace(Msg, "@A@", AmountA)
         Msg = VBA.Replace(Msg, "@B@", AmountB)
         
         MsgBox Format(Date, "dddd d mmmm, yyyy") & ":" & vbNewLine & vbNewLine & Msg, vbInformation, "Miles Run YTD"
         
         Case Else: 'YTD mlg greater than this time last year
         Msg = "If you're going for a run today, then before this run:" & vbNewLine & vbNewLine & _
          "- You were @A@ behind the " & Range("PreYear") & " year end total" & vbNewLine & vbNewLine & _
          "- You were @B@ in front of the " & Year(Now) - 1 & " year to date total"

         AmountA = CLng(Range("MilesToNextYearEndTotal"))
         AmountB = CLng(Abs(.Value))
         TextA = AmountA & " mile":  If AmountA > 1 Then TextA = TextA & "s"
         TextB = AmountB & " mile":  If AmountB > 1 Then TextB = TextB & "s"

         Msg = VBA.Replace(Msg, "@A@", AmountA)
         Msg = VBA.Replace(Msg, "@B@", AmountB)

         MsgBox Format(Date, "dddd d mmmm, yyyy") & ":" & vbNewLine & vbNewLine & Msg, vbInformation, "Miles Run YTD"

      End Select
   End With
            'CLng rounds the figure up or down to the nearest whole number (integer).  "Abs" added to hide the negative prefix.
Thanks again!
 
Upvote 0
Very stupid mistake on my part, this snippet ...

VBA Code: 
         Msg = VBA.Replace(Msg, "@A@", AmountA)
         Msg = VBA.Replace(Msg, "@B@", AmountB)

should have looked like this:
Rich (BB code): 
         Msg = VBA.Replace(Msg, "@A@", TextA)
         Msg = VBA.Replace(Msg, "@B@", TextB)
 
Upvote 0
No worries, you're way above me, I'd never have figured that out myself :)

It works perfectly now, many thanks GWteB!
 
Upvote 0
If you want you can shorten your code a bit:

VBA Code: 
    Dim AmountA As Long, AmountB As Long
    Dim TextA As String, TextB As String, Msg As String
    With Sheets("Training Log").Range("E5")

        AmountA = CLng(Range("MilesToNextYearEndTotal"))
        AmountB = CLng(Abs(.Value))

        TextA = AmountA & " mile":  If AmountA > 1 Then TextA = TextA & "s "
        TextB = AmountB & " mile":  If AmountB > 1 Then TextB = TextB & "s "

        Msg = "If you're going for a run today, then before this run:" & vbNewLine & vbNewLine & _
              "- You @A@ the " & Range("PreYear") & " year end total" & vbNewLine & vbNewLine & _
              "- You @B@ the " & Year(Now) - 1 & " year to date total"

        Select Case .Value
         
        Case Is < 0:                             'YTD mlg less than this time last year
            Msg = VBA.Replace(Msg, "@A@", "were " & TextA & " behind")
            Msg = VBA.Replace(Msg, "@B@", "were " & TextB & " behind")

        Case 0:                                  'YTD mlg the same as this time last year
            Msg = VBA.Replace(Msg, "@A@", "had " & TextA & " to beat")
            Msg = VBA.Replace(Msg, "@B@", "had " & TextB & " to beat")

        Case Else:                               'YTD mlg greater than this time last year
            Msg = VBA.Replace(Msg, "@A@", "were " & TextA & " behind")
            Msg = VBA.Replace(Msg, "@B@", "were " & TextB & " in front of")

        End Select

        MsgBox Format(Date, "dddd d mmmm, yyyy") & ":" & vbNewLine & vbNewLine & Msg, vbInformation, "Miles Run YTD"

    End With
 
Upvote 0
Hey, that's neat and kind of you to think of doing that - thanks a lot once again!
 
Upvote 0
Hi again GWteB - I'm sorry for being a bit pedantic, but I've just discovered that when the value for TextA is in double digits, there's a 1 character gap before the normal space before the text that follows it. I tried to modify it myself but then there's no space at all.

Hope it's fixable?

Thanks again!
 
Upvote 0
It turns out there's a space after the letter "s" of the word "miles". Removing that space should remove the 1 character gap.

VBA Code: 
    Dim AmountA As Long, AmountB As Long
    Dim TextA As String, TextB As String, Msg As String
    With Sheets("Training Log").Range("E5")
        AmountA = CLng(Range("MilesToNextYearEndTotal"))
        AmountB = CLng(Abs(.Value))

        TextA = AmountA & " mile":  If AmountA > 1 Then TextA = TextA & "s"
        TextB = AmountB & " mile":  If AmountB > 1 Then TextB = TextB & "s"

        Msg = "If you're going for a run today, then before this run:" & vbNewLine & vbNewLine & _
              "- You @A@ the " & Range("PreYear") & " year end total" & vbNewLine & vbNewLine & _
              "- You @B@ the " & Year(Now) - 1 & " year to date total"

        Select Case .Value

        Case Is < 0:                             'YTD mlg less than this time last year
            Msg = VBA.Replace(Msg, "@A@", "were " & TextA & " behind")
            Msg = VBA.Replace(Msg, "@B@", "were " & TextB & " behind")

        Case 0:                                  'YTD mlg the same as this time last year
            Msg = VBA.Replace(Msg, "@A@", "had " & TextA & " to beat")
            Msg = VBA.Replace(Msg, "@B@", "had " & TextB & " to beat")

        Case Else:                               'YTD mlg greater than this time last year
            Msg = VBA.Replace(Msg, "@A@", "were " & TextA & " behind")
            Msg = VBA.Replace(Msg, "@B@", "were " & TextB & " in front of")

        End Select

        MsgBox Format(Date, "dddd d mmmm, yyyy") & ":" & vbNewLine & vbNewLine & Msg, vbInformation, "Miles Run YTD"
     End With
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

H
  • Solved
Cannot supress Display alert Message
Replies
4
Views
406
howard
H
Ironman
  • Solved
Don't run Worksheet_Change Event when a zero value is entered?
Replies
4
Views
559
GWteB
GWteB
Ironman
  • Solved
Unable to use .select in worksheet_change event
Replies
3
Views
398
Fluff
Fluff
C
  • Question
VBA Copy Sort
Replies
4
Views
147
Keebler
Keebler
H
  • Solved
Macro to display message end of Code where Col D contains blanks
Replies
7
Views
342
howard
H

Forum statistics

Threads
1,215,151
Messages
6,123,319
Members
449,094
Latest member
Chestertim

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top