How to Insert Dash Between Letters and Decimal Number?

[ItsDavid]

Hello all,

I am brand new to the forum and this is my first post.

I am very new to VBA and by far an expert and was hoping to find some help here.

I currently have a worksheet that gets used by many different users so trying to make sure that everyone enters the data into cells the same is no easy task so I would like to use VBA Worksheet_Change to auto format these cells but with all attempts I have come close, however, nothing as been to perfection. I have searched Google, Bing and found many forum posts from here in the search results but to no avail. With that said let me explain what I have going on.

In the worksheet there are 13 different codes in a named range that start with letters ranging from 2 letters to 4 letters, (ab, abc, abcd) I would like to have a dash ("-") automatically inserted after the letter codes when the user hits enter to avoid relying on each user typing it manually.

The dash is followed by a decimal number that the user manually enters such as .25, .5, .75, 1.0, 1.25, 1.5, 1.75 etc.

If it's possible I would also like to allow the user to type the entry with or without spaces and have it auto format such as (abcd1.75) becomes (abcd - 1.75) when the user hits enter

I would also like it so it will follow the automatic format pattern if the user enters (abc 1.75) it becomes (abc - 1.75) when the user hits enter.

I would also like to restrict these cells to only accept values that begin with any one of the 13 letter codes and follow the pattern outlined, ab - decimal number, abc - decimal number, abcd - decimal number.


The cells the data is entered into by the user is in a named range.

I am hoping this is something that can be done with VBA or Regex. I did use the Autoformat Proofing features of excel which worked great on my PC only and did not work for anyone else.


Thank you in advance.

 

[Peter_SSs]

There may be some backward steps in this (let me know any that you find) but also some forward steps. Give it a go.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim RX As Object
  Dim Changed As Range, c As Range
  Dim s As String, tuCode As String, numpart As String, opt1 As String, opt2 As String
  
  
  Set Changed = Intersect(Target, Range("CalDay"))
  If Not Changed Is Nothing Then
    If Changed.Count = 1 Then
      If Len(Changed.Value) > 0 Then
        Set RX = CreateObject("VBScript.RegExp")
        RX.IgnoreCase = True
        For Each c In Range("tuCodes")
          If Len(c.Value) > 0 Then s = s & "|" & c.Value
        Next c
        RX.Pattern = "^(" & Mid(s, 2) & ")((\d+\.?\d*)|(\d*\.?\d+))$"
        RX.Pattern = "^(" & Mid(s, 2) & ")(([0-7]\.[0,5]?)|([0-7]\.?(0|00|25|5|50|75)?)|(8|80|800|8.0|8.00))$"
        Application.EnableEvents = False
        s = Replace(Replace(Changed.Value, " ", ""), "-", "")
        If RX.Test(s) Then
          tuCode = RX.Execute(s)(0).Submatches(0)
          numpart = RX.Execute(s)(0).Submatches(1)
          Select Case True
            Case Left(numpart, 1) = "8"
              numpart = "8.0"
            Case numpart Like "###"
              numpart = Left(numpart, 1) & "." & Right(numpart, 2)
            Case numpart Like "#5"
              opt1 = "." & numpart
              opt2 = Left(numpart, 1) & "." & Right(numpart, 1)
              Do While numpart <> opt1 And numpart <> opt2
                numpart = InputBox(Prompt:="You entered " & numpart & " hours." & vbLf & "Did you mean " & opt1 & " or " & opt2 & "?", Default:=opt2)
              Loop
            Case numpart Like "#"
              numpart = numpart & ".0"
          End Select
          Changed.Value = tuCode & " - " & numpart
        Else
          Changed.Select
          MsgBox "Entry invalid. You may only enter values from the list of available codes and quarter hour increments up to 8.0"
          Changed.ClearContents
        End If
        Application.EnableEvents = True
      End If
    End If
  End If
End Sub

 

[ItsDavid]

There may be some backward steps in this (let me know any that you find) but also some forward steps. Give it a go.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim RX As Object
  Dim Changed As Range, c As Range
  Dim s As String, tuCode As String, numpart As String, opt1 As String, opt2 As String
 
 
  Set Changed = Intersect(Target, Range("CalDay"))
  If Not Changed Is Nothing Then
    If Changed.Count = 1 Then
      If Len(Changed.Value) > 0 Then
        Set RX = CreateObject("VBScript.RegExp")
        RX.IgnoreCase = True
        For Each c In Range("tuCodes")
          If Len(c.Value) > 0 Then s = s & "|" & c.Value
        Next c
        RX.Pattern = "^(" & Mid(s, 2) & ")((\d+\.?\d*)|(\d*\.?\d+))$"
        RX.Pattern = "^(" & Mid(s, 2) & ")(([0-7]\.[0,5]?)|([0-7]\.?(0|00|25|5|50|75)?)|(8|80|800|8.0|8.00))$"
        Application.EnableEvents = False
        s = Replace(Replace(Changed.Value, " ", ""), "-", "")
        If RX.Test(s) Then
          tuCode = RX.Execute(s)(0).Submatches(0)
          numpart = RX.Execute(s)(0).Submatches(1)
          Select Case True
            Case Left(numpart, 1) = "8"
              numpart = "8.0"
            Case numpart Like "###"
              numpart = Left(numpart, 1) & "." & Right(numpart, 2)
            Case numpart Like "#5"
              opt1 = "." & numpart
              opt2 = Left(numpart, 1) & "." & Right(numpart, 1)
              Do While numpart <> opt1 And numpart <> opt2
                numpart = InputBox(Prompt:="You entered " & numpart & " hours." & vbLf & "Did you mean " & opt1 & " or " & opt2 & "?", Default:=opt2)
              Loop
            Case numpart Like "#"
              numpart = numpart & ".0"
          End Select
          Changed.Value = tuCode & " - " & numpart
        Else
          Changed.Select
          MsgBox "Entry invalid. You may only enter values from the list of available codes and quarter hour increments up to 8.0"
          Changed.ClearContents
        End If
        Application.EnableEvents = True
      End If
    End If
  End If
End Sub

This is close, however, you prediction of it having some steps backwards was correct. It does also have some nice steps forward.

Here is my findings.

1. When I enter any value (cade10, code20, code30, code40, code50, code60 and code70) it enters the value into the cell as (code - 10, code - 20, code - 30, code - 40, code - 50, code - 60 , code - 70) but if I enter (code80) it will auto format it as (code - 8.0) as it should be.

I have not been able to find a solution to correct the issue going on with number 1. I tried adding a "Case Left(numpart, 1) = "1" numpart = "1.0" for each number 1 through 8 which resulted in the period "." being added, however, that made it so if I entered (Code275) it would strip the "75" and enter the value as (Code - 2.0). So I figured I may not be on the right track to fixing it correctly.


2. When I enter any (code15 through 65) it will prompt for the correct value "You entered 15 hours. Did you mean .15 or 1.5?" which is excellent however, if I enter (code75) it will automatically enter the value into the cell as (code - 70) without prompting or adding the "." period. all other 15. When I enter (code85) it prompts that I have entered an invalid entry as it should.

3. When I enter any value as (code175, code275, code375, code475, code575, code675) it works as it should and formats as the following (code - 1.75, code - 2.75, code - 3.75, code - 4.75, code - 5.75, code - 6.75,) but again entering (code775) results in the value being entered into the cell as (code - 7.0)

I believe I have corrected this issue with the 7's by changing the following from

RX.Pattern = "^(" & Mid(s, 2) & ")(([0-7]\.[0,5]?)|([0-7]\.?(0|00|25|5|50|75)?)|(8|80|800|8.0|8.00))$"

To

RX.Pattern = "^(" & Mid(s, 2) & ")(([0-8]\.[0,5]?)|([0-8]\.?(0|00|25|5|50|75)?)|(8|80|800|8.0|8.00))$"

Making these changes above has corrected the problem I was having with the 7's. Is this an appropriate fix for that?


Everything else seems to be working as it should.

Thank you again.

 

[ItsDavid]

There is one the thing I have discovered.

If a user enters a value like (code.25) or (code .25) the invalid entry error pops up. These would be valid entries (code.25, code .25, code.5, code .5, code.75 and code .75)

At the moment if a user types any of the following above without the period ".", they are prompted with a pop up to clarify if they intended to input 7.5 or .75. This is working great.

 

[Peter_SSs]

Hmm, a few more backward steps than I hoped. ?
But let's see if we can address them.

however, if I enter (code75) it will automatically enter the value into the cell as (code - 70)

entering (code775) results in the value being entered into the cell as (code - 7.0)

I don't get either of those. Could it be that this happened after you made the change mentioned under point 1 in post #12?
For me
code75 brings up the 7.5/.75 message box and uses that result.
code775 automatically enters code - 7.75

without prompting or adding the "." period. all other 15.

I didn't understand what this red bit meant.

user enters a value like (code.25) or (code .25) the invalid entry error pops up.

Now addressed (I hope)

Give this one a try. It has a couple of tweaks to the Pattern and one more 'Case' section.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim RX As Object
  Dim Changed As Range, c As Range
  Dim s As String, tuCode As String, numpart As String, opt1 As String, opt2 As String
  
  
  Set Changed = Intersect(Target, Range("CalDay"))
  If Not Changed Is Nothing Then
    If Changed.Count = 1 Then
      If Len(Changed.Value) > 0 Then
        Set RX = CreateObject("VBScript.RegExp")
        RX.IgnoreCase = True
        For Each c In Range("tuCodes")
          If Len(c.Value) > 0 Then s = s & "|" & c.Value
        Next c
        RX.Pattern = "^(" & Mid(s, 2) & ")(([0-7]?\.([0,5]|[2,7]5)?)|([0-7]\.?(0|00|25|5|50|75)?)|(8|80|800|8.0|8.00))$"
        Application.EnableEvents = False
        s = Replace(Replace(Changed.Value, " ", ""), "-", "")
        If RX.Test(s) Then
          tuCode = RX.Execute(s)(0).Submatches(0)
          numpart = RX.Execute(s)(0).Submatches(1)
          Select Case True
            Case Left(numpart, 1) = "8"
              numpart = "8.0"
            Case numpart Like "###"
              numpart = Left(numpart, 1) & "." & Right(numpart, 2)
            Case numpart Like "#5"
              opt1 = "." & numpart
              opt2 = Left(numpart, 1) & "." & Right(numpart, 1)
              Do While numpart <> opt1 And numpart <> opt2
                numpart = InputBox(Prompt:="You entered " & numpart & " hours." & vbLf & "Did you mean " & opt1 & " or " & opt2 & "?", Default:=opt2)
              Loop
            Case numpart Like "#0"
              numpart = Left(numpart, 1) & "." & Right(numpart, 1)
            Case numpart Like "#"
              numpart = numpart & ".0"
          End Select
          Changed.Value = tuCode & " - " & numpart
        Else
          Changed.Select
          MsgBox "Entry invalid. You may only enter values from the list of available codes and quarter hour increments up to 8.0"
          Changed.ClearContents
        End If
        Application.EnableEvents = True
      End If
    End If
  End If
End Sub

 

[ItsDavid]

all other 15.

You can disregard that. My fingers got a head of me and I did not catch it before hitting reply. Sorry for the confusion.

You can also disregard the (code775) and others above. as they no longer exists.

At current everything seems to work as it should except for one this that wasn't happening before.

Whenever I type any of the following (code15, code25, code35, code45, code55, code65, code75) I am prompted with the You Entered popup giving me and option to pick either(.15, .25, .35, .45, .55, .65, .75)

Is there a way to omit the popup prompt for the following (code15, code35, code45, code55, code65, code75) and have them automatically convert to (code - 1.5, code - 3.5, code - 4.5, code - 5.5, code - 6.5, code - 7.5) just the same as typing code1 or code10 automatically formats to code - 1.0?

These increments .15, .35, .45, .55, .65, .75 are not used in our sheet and every this is in increments of a quarter (.25, .5, .75, 1.0) so those are the ones that matter for the popup.

I may be stuck with the way this last topic works.

the number 5.

Currently any number typed in after "code" such as (code1 or code 01, code2 or code 02 etc..) yields a very nice format automatically and I like it very much, thank you again.

Do we have any options with the number 5 like maybe a popup like the others that asks did you mean .5 or 5.0 when manually typing (code5)? currently the period has to be manually typed in (code.5) to get the correct format for (code - .5). The 5 is the only one that requires you to manually type (code.5) and I can see many of the users getting confused over such a small thing.

If there are options available to address these last two things, we are heading for perfection.

 

[Peter_SSs]

You can also disregard the (code775) and others above. as they no longer exists.

Are you saying that the maximum allowed hours is now 7.5 and that both 7.75 and 8.0 are no longer allowed?

These increments .15, .35, .45, .55, .65, .75 are not used in our sheet and every this is in increments of a quarter (.25, .5, .75, 1.0) so those are the ones that matter for the popup.

Appears to be a contradiction. Was the red .75 a mistake?

 

[ItsDavid]

Are you saying that the maximum allowed hours is now 7.5 and that both 7.75 and 8.0 are no longer allowed?

No these are still allowed. What I was trying to make clear is that originally from the very first code you provided when I typed (code775) it was converting it to (code - 7.0) and that I have changed the number (7) in the pattern code and it begun working as it should so manually typing (code775) begun formatting like the rest of the numbers in that class (code - 7.75) so I was saying you can disregard my previous report that it was not formatting correctly. apologies for any confusion.

Appears to be a contradiction. Was the red .75 a mistake?

You are correct, that was a mistake.

 

[Peter_SSs]

Been fiddling a bit and considering some slightly different approaches but any gains seem to always be offset by some losses. I'm going to shelve it for a day or so and hope the brain-fog clears a little.

 

[ItsDavid]

Been fiddling a bit and considering some slightly different approaches but any gains seem to always be offset by some losses. I'm going to shelve it for a day or so and hope the brain-fog clears a little.

I have been playing with it quite a bit myself but to now avail.

One thing I have discovered while testing is that if I enter the value (code.25) I am prompted with the "Entry invalid" message, however, if I enter (code25) I am prompted with the "Did you mean" message and if I type (.25) the value is accepted.

What I find strange is that typing any of the following works as it should without the prompt, (code.5, code.75). I am guessing it has something to do with the pattern?

 

[Peter_SSs]

Fingers crossed for at least some improvement. ?

I have gone for more of a brute force approach with the pattern.
I have also assumed (forgot to ask before) that 0 is not a valid value for the hours entered.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim RX As Object
  Dim Changed As Range, c As Range
  Dim s As String, tuCode As String, numpart As String, tmp As String, opt1 As String, opt2 As String
  Dim i As Long
  Dim bValid As Boolean
  
  Set Changed = Intersect(Target, Range("CalDay"))
  If Not Changed Is Nothing Then
    If Changed.Count = 1 Then
      If Len(Changed.Value) > 0 Then
        Set RX = CreateObject("VBScript.RegExp")
        RX.IgnoreCase = True
        For Each c In Range("tuCodes")
          If Len(c.Value) > 0 Then s = s & "|" & c.Value
        Next c
        RX.Pattern = "^(" & Mid(s, 2) & ")( ?-? ?)" _
                      & "(1|2|3|4|5|6|7|8|1.|2.|3.|4.|5.|6.|7.|8.|1.0|2.0|3.0|4.0|5.0|6.0|7.0|8.0|1.00|2.00|3.00|4.00|5.00|6.00|7.00|8.00|" _
                      & ".25|.5|.75|1.25|1.5|1.75|2.25|2.5|2.75|3.25|3.5|3.75|4.25|4.5|4.75|5.25|5.5|5.75|6.25|6.5|6.75|7.25|7.5|7.75|" _
                      & ".50|1.50|2.50|3.50|4.50|5.50|6.50|7.50|0.25|0.5|0.75|25|75|50)$"
        Application.EnableEvents = False
        s = Replace(Changed.Value, " ", "")
        If RX.Test(s) Then
          tuCode = RX.Execute(s)(0).Submatches(0)
          numpart = RX.Execute(s)(0).Submatches(2)
          bValid = True
          Select Case Val(numpart)
            Case 25, 50, 75
              opt1 = Left(Val(numpart), 1) & "." & Right(Val(numpart), 1)
              opt2 = "0." & Val(numpart)
              Do While Val(numpart) <> Val(opt1) And Val(numpart) <> Val(opt2)
                numpart = InputBox(Prompt:="You entered " & numpart & " hours." & vbLf & "Did you mean " & opt1 & " or " & opt2 & "?", Default:=opt1)
              Loop
              If Left(numpart, 1) = "." Then numpart = 0 & numpart
            Case Is < 1
              numpart = Val(numpart)
            Case 1 To 8
              If InStr(1, numpart, ".") = 0 Or Right(numpart, 1) = "." Then numpart = Replace(numpart, ".", "") & ".0"
            Case Else
              bValid = False
              For i = 1 To Len(numpart)
                tmp = Left(numpart, i - 1) & "." & Mid(numpart, i)
                If InStr(1, RX.Pattern, tmp) > 0 Then
                  numpart = tmp
                  bValid = True
                  Exit For
                End If
              Next i
          End Select
        End If
        If bValid Then
          Changed.Value = tuCode & " - " & numpart
        Else
          Changed.Select
          MsgBox "Entry invalid. You may only enter values from the list of available codes and quarter hour increments up to 8.0"
          Changed.ClearContents
        End If
        Application.EnableEvents = True
      End If
    End If
  End If
End Sub