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

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
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

I
  • Question Question
Making code easier to work with at start of new tax year
Replies
2
Views
171
ipbr21054
I
D
  • Question Question
VBA Code to Apply an AVERAGE of a Range on Cells as New Records are added Via a User Form
Replies
2
Views
72
Denny57
D
D
  • Question Question
Error Retrieving data with XLOOKUP after using VBA to copy to source cells.
Replies
6
Views
389
Alex Blakenburg
A
H
  • Solved
Cannot supress Display alert Message
Replies
4
Views
559
howard
H
F
  • Solved
Delimiters in VBA has different result than manual
Replies
7
Views
92
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,911
Messages
6,175,324
Members
452,635
Latest member
laura12345

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