Page 1 of 2 12 LastLast
Results 1 to 15 of 27
  1. #1
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts

    Create a custom number format

    Hi

    I have an input cell where the user needs to enter a project number. An example of a project number is 0194-0722-AB. It always starts with a zero, 4 digits, a hyphen, 4 digits, a hyphen, and two letters in uppercase. I found the following code but I am having difficulty altering the code to meet my needs.

    Code:
    Option Explicit
    
     Private Sub Worksheet_Change(ByVal Target As Range)
    
     If Intersect(Target, Range("H5:H55")) Is Nothing Then Exit Sub
     Application.EnableEvents = False
     Target.Value = Left(Target.Text, 4) & "-" & Mid(Target.Text, 4) & "-" & Right(Target.Text, 2)
     Application.EnableEvents = True
    
     End Sub
    This code is not giving me the right results--I also need Upper for the last two alpha characters.
    Jean

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    The code posted tries to reformat the input given but does not really verify it's format and may give undesired results IMHO.

    Here's some code that will completely check the format and provide an error message if it is incorrect.
    Code:
    Option Explicit
    
     Private Sub Worksheet_Change(ByVal Target As Range)
     
       Dim zParts As Variant
       Dim iCntr  As Integer
       Dim bError As Boolean
       Dim zStr   As String
    
       If Intersect(Target, Range("H5:H55")) Is Nothing Then Exit Sub
     
       Application.EnableEvents = False
       bError = False
       
       zParts = Split(Target, "-")
      
       If UBound(zParts) <> 2 Then
         bError = True
       Else
         If Len(zParts(2)) <> 2 Or UCase(zParts(2)) <> zParts(2) Then
           bError = True
         Else
           If Len(zParts(0)) <> 4 Or Len(zParts(1)) <> 4 Then
             bError = True
           Else
             zStr = zParts(0) & zParts(1)
             For iCntr = 1 To Len(zStr)   '*** Check for non-numeric characters ***
                If Asc(Mid(zStr, iCntr, 1)) < 48 Or _
                   Asc(Mid(zStr, iCntr, 1)) > 57 Then
                  bError = True
                  Exit For
                End If
             Next iCntr
           End If
         End If
       End If
      
       Application.EnableEvents = True
    
       If bError Then
         MsgBox "Part Number: " & Target & " is not correctly formatted!" & _
                vbCrLf & vbCrLf & "The correct format is ####-####-AA" & _
                vbCrLf & "Ex: 1234-5678-XY" & _
                vbCrLf & "Please Correct.", _
                vbOKOnly + vbCritical, _
                "Error: Part Number Format"
       End If
       
     End Sub
    jean.JPG

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. The Following User Says Thank You to RetiredGeek For This Useful Post:

    JeanM (2014-09-04)

  4. #3
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts

    Create a custom number format

    Hi RG

    Is there any way I can use the code you provided into the following existing code: It was so easy formatting percent!! Jean

    Code:
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.DisplayAlerts = False
    If ActiveWorkbook.Saved = False Then
    ActiveWorkbook.Save
    End If
    With Sheets("Invoice").Range("g3")
    If Len(Trim(.Value)) = 0 Then
    UsrName = Application.InputBox("Please Enter Date", "Date Required-INVOICE")
    If UsrName = "HSO" Then Exit Sub 'CHANGE PASSWORD
    If UsrName = "False" Or Len(Trim(UsrName)) = 0 Then
    Cancel = True
    Else
    .Value = UsrName
    End If
    End If
    End With
    UsrName = Application.InputBox("Please Enter Fringe Rate-DO NOT TYPE A % SIGN/IF 0 MUST TYPE A 0", "Fringe Rate Required-INVOICE") / 100
    If UsrName = "False" Or Len(Trim(UsrName)) = 0 Then
    Cancel = True
    Else
    .Value = UsrName
    End If
    End If
    End With
    With Sheets("Cover").Range("H37")
    If Len(Trim(.Value)) = 0 Then
    UsrName = Application.InputBox("Please Enter Project Number", "Project Number Required-COVER")
    If UsrName = "False" Or Len(Trim(UsrName)) = 0 Then
    Cancel = True
    Else
    .Value = UsrName
    End If
    End If
    End With
    End Sub

  5. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    The code you provided is an Exit routine that checks the entire workbook.

    The code I provided will execute on each cell in the check range as the data is input so there is no need to check it on exit.

    Am I missing something?
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  6. #5
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts
    Hi RG

    This works great if my user group fills-in the cell but I wanted it to also work on exit or close. I was looking for a way that the input box would retain the format and the user would not have to type in the apostrophe or hyphens or be concerned with the 2-upper case alpha letters. I realize my initial question was not clear and I apologize for not being clear--it has been one of those weeks! I will use your code on the sheet where the project number is suppose to be filled-in. If you want to pursue this any further I appreciate all the help; otherwise, this is as good as it gets!

    Jean

  7. #6
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    Unfortunately, for me at least, you got my brain churning and I just had to solve this. So here's the solution I came up with, and as I said it is much more involved!

    Using the WorkSheet_SelectionChange Event we are able to display a UserForm if the cell clicked falls with in the range specified.
    Code:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
       If Intersect(Target, Range("H5:H55")) Is Nothing Then Exit Sub
    
       ufProjEntry.Show
    
    End Sub

    That of course is the easy part. Now we have to design a form and then create event code to do our checking.
    Code:
    Option Explicit
    
    Private Sub UserForm_Activate()
      
       With ActiveCell
           If Trim(.Value) <> "" Then
             tbProjNoPt1 = Left(.Value, 4)
             tbProjNoPt2 = Mid(.Value, 6, 4)
             tbProjNoPt3 = Right(.Value, 2)
           Else
             tbProjNoPt1 = ""
             tbProjNoPt2 = ""
             tbProjNoPt2 = ""
           End If
           
       End With
       
    End Sub
    
    Private Sub cmdOK_Click()
    
      ActiveCell.Value = tbProjNoPt1 & "-" & tbProjNoPt2 & "-" & _
                        UCase(tbProjNoPt3)
      Me.Hide
      
    End Sub
    
    Private Sub tbProjNoPt1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
       Dim icntr As Integer
       
       If Len(tbProjNoPt1) <> 4 Then
       
         MsgBox "Part 1 of Project number is not 4 characters." & _
                vbCrLf & vbCrLf & "Please Correct...", _
                vbOKOnly + vbInformation, _
                "Error: Project Number Length"
         Cancel = True
         
       Else
       
         For icntr = 1 To Len(tbProjNoPt1) '*** Check for non-numeric characters ***
            If Asc(Mid(tbProjNoPt1, icntr, 1)) < 48 Or _
               Asc(Mid(tbProjNoPt1, icntr, 1)) > 57 Then
              MsgBox "Part 1 of Project number contains non-numeric characters." & _
                      vbCrLf & vbCrLf & "Please Correct...", _
                      vbOKOnly + vbInformation, _
                     "Error: Project Number has Invalid Characters"
              Cancel = True
              Exit For
            End If
         Next icntr
    
       End If
    
    End Sub
    
    Private Sub tbProjNoPt2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
       Dim icntr As Integer
       
       If Len(tbProjNoPt2) <> 4 Then
       
         MsgBox "Part 2 of Project number is not 4 characters." & _
                vbCrLf & vbCrLf & "Please Correct...", _
                vbOKOnly + vbInformation, _
                "Error: Project Number Length"
         Cancel = True
         
       Else
       
         For icntr = 1 To Len(tbProjNoPt2) '*** Check for non-numeric characters ***
            If Asc(Mid(tbProjNoPt2, icntr, 1)) < 48 Or _
               Asc(Mid(tbProjNoPt2, icntr, 1)) > 57 Then
              MsgBox "Part 2 of Project number contains non-numeric characters." & _
                      vbCrLf & vbCrLf & "Please Correct...", _
                      vbOKOnly + vbInformation, _
                     "Error: Project Number has Invalid Characters"
              Cancel = True
              Exit For
            End If
         Next icntr
    
       End If
    
    End Sub
    
    Private Sub tbProjNoPt3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
       Dim icntr As Integer
       
       If Len(tbProjNoPt3) <> 2 Then
       
         MsgBox "Part 3 of Project number is not 2 characters." & _
                vbCrLf & vbCrLf & "Please Correct...", _
                vbOKOnly + vbInformation, _
                "Error: Project Number Length"
         Cancel = True
         
       Else
       
         For icntr = 1 To Len(tbProjNoPt3) '*** Check for non-numeric characters ***
            If Asc(UCase(Mid(tbProjNoPt3, icntr, 1))) < 65 Or _
               Asc(UCase(Mid(tbProjNoPt3, icntr, 1))) > 90 Then
              MsgBox "Part 3 of Project number contains non-alphebetic characters." & _
                      vbCrLf & vbCrLf & "Please Correct...", _
                      vbOKOnly + vbInformation, _
                     "Error: Project Number has Invalid Characters"
              Cancel = True
              Exit For
            End If
         Next icntr
    
       End If
    
    End Sub
    This leads us to this when the user clicks in the specified range.
    UserFormonCLick.JPG

    The fields on the form are limited in length, e.g. 4 for the 1st 2 and 2 for the 3rd. The other checking is done via the field Exit event and message boxes are displayed if the other parameters are found to be in error.
    errormsg.JPG
    BTW: the alpha part is converted to upper case before being placed on the worksheet.

    Of course, this is just the tip of the iceberg as many more options could be added but we at least know it can be done, that is if this is what you were seeking.

    Test Workbook: Jean.xlsm
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  8. #7
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts
    Hi RG

    The code here is great but I do not know how to incorporate into what I already have. This user group makes so many mistakes with entering the Project Number that it drives me crazy with editing. I do not know how much more you really want to work on this but I think it would be best to attach the workbook so you can see the whole picture. Please get back to me if you want me to attach?

    Jean

  9. #8
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    Sure load it up and I'll take a look.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  10. #9
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts

    Create a Custom Number Format

    Hi RG

    The sheet "Cover" is where I want the user to type in the Project Number. I did add in your previous code into this sheet. "This Workbook" has the exit code which will drive you crazy--so if you do not want to answer all the fields that I am trying to catch on exit then type in "HSO" (no quotes) in the first input box--Maudibe helped me here with code. You were so helpful with the text box code but I changed the sheet "Recap" and did not use text boxes. Keep in mind I wrote the exit code and I am not that savvy in writing code but it did the trick.

    Jean
    Have fun!
    Attached Files Attached Files

  11. #10
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    Ok, here is the file with the menu integrated.
    FOR RG.xlsm

    Please note I have disabled your EXIT code! To re-enable when you open the file just go to the ThisWorkbook Module and delete the two lines as per the comment.

    BTW: What I did was to Export the form from my sample file and then Import it into your file. This brings the form and all the code associated with the form in in one fell swoop. Then I just commented out the previous routine for checking Project Numbers and inserted the SelectionChange code as posted above.

    FYI: I highly recommend you start indenting and adding blank lines to your code. It is a little more work but it makes it much easier to read and there is no real file size or execution speed penalties for doing so.

    From a quick look at the rest of this file IMHO it would be improved greatly by the addition of more custom menus that would then fill in the worksheets. This gives you the programmer much greater control over what the "USERS" do and how they do it. YMMV.

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  12. The Following User Says Thank You to RetiredGeek For This Useful Post:

    JeanM (2014-09-06)

  13. #11
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts
    Hi RG

    I finally had a chance to play with the form in the cover sheet and I really like how it works. I enabled the exit code and did not have the same success with the input box. On the exit code the user does not have to type the apostrophe but still has to type the hyphens and capital letters. If the user does not type the hyphens for example 01940722ac it turns into 0194-722a-ac if the user goes to the cover sheet and clicks in the Project # field. I think I will take out the input box on exit for the Project #. What do you think?

    Jean
    Thanks

  14. #12
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    Why not replace your exit code with this:
    Code:
    Sheets("Cover").Range("H37").Select
        If Len(Trim(ActiveCell.Value)) = 0 Then
            ufProjEntry.Show
        End If
    This will call the form and since the user must enter a valid Proj No you're covered.

    You can also considerably clean up your exit code if you are interested, it will take some work but will be well worth it in the long run. Let me know and I'll post back.
    HTH
    Last edited by RetiredGeek; 2014-09-06 at 18:41.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  15. The Following User Says Thank You to RetiredGeek For This Useful Post:

    JeanM (2014-09-07)

  16. #13
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts
    Hi RG

    That works great--exactly what I needed for my user group. As for cleaning up the exit code, I am agreeable if you want to tackle it, but I hope I am not taking you from more challenging questions in the forum. The exit code does not catch every aspect of the workbook--I only chose the cells that seem to be the ones that consistently are omitted or something new that user group has not seen yet. I know that some of these exit cells need some restrictions such as only accepting a number format or a date format. Get back to me if you truly what to clean up the exit code--I hope I did not misinterpret your last post! Thank you for all the help.

    You really got me thinking about using a fill-in form in some other areas of the wb--I have cells that requires start time and end time which would lend itself better to a fill-in form. The user has to enter the time as 5 pm or 17:00 in order for it to appear as military time. If the user does not enter time in correctly then the hours worked does not calculate correctly. This will be a challenge for me if I can manipulate the code and make it work--hope I can tap into your expertise.

    Jean
    FYI: I have had such great help from this forum and I did not realize the "thank you" button until recently--I truly thank everyone who has helped me in the past.

  17. #14
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Jean,

    Step one on cleaning up the code would be to eliminate as much redundant code as possible. To do this in the exit routine you would create a Function to display the error messages and inputbox for the required data as such:
    Code:
    Option Explicit
    
    '                         +-------------------------+             +----------+
    '-------------------------|    zMissingData()       |-------------| 09/06/14 |
    '                         +-------------------------+             +----------+
    'Calling Pattern:
    '  Cancel = zMissingData(Range("[celladdr | RangeName]"), "Message/Prompt", _
    '                              "WindowTitle")
    '  Ex: Cancel = zMissingData(Range("InvDate"), "Please Enter Date", _
    '                                              "Date Required-INVOICE")
    '      If Cancel Then Exit Sub
    '
    'Note: Assumes caller has a cancel argument!
    
    Function zMissingData(rngTarget As Range, zMessage As String, _
                          zWinTitle As String) As Boolean
                          
     Dim zResponse As String
                          
     With rngTarget
        If Len(Trim(.Value)) = 0 Then
          zResponse = Application.InputBox(zMessage, zWinTitle)
          If zResponse = "False" Or Len(Trim(zResponse)) = 0 Then
            zMissingData = True
          Else
            .Value = zResponse
            zMissingData = False
          End If
        End If
    End With
                          
    End Function 'zMissingData
    The Exit code then becomes simpler and easier to read as follows:
    Code:
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    Application.DisplayAlerts = False
    
    'If ActiveWorkbook.Saved = False Then
    '  ActiveWorkbook.Save
    'End If
    
        Cancel = zMissingData(Range("InvDate"), "Please Enter Date", "Date Required-INVOICE")
        If Cancel Then Exit Sub
    
        Cancel = zMissingData(Range("HolidayName"), "Please Enter Name of Grant Contact", "Name Required-HOLIDAY")
        If Cancel Then Exit Sub
        
    End Sub
    Of course the above only does the first two checks but you get the idea. You'll note the If Cancel Then Exit Sub line. In you existing code the exit would not work correctly since the Cancel parameter isn't examined until you exit the routine thus you have to cycle through all of the prompts even though the User didn't answer one correctly. IMHO it's better to exit immediately letting the user know that they have to answer the question before continuing.

    Note: You'll also notice that I've Named the cells where the data goes rather than using the cell addresses! This makes it much easier to read the code and Eliminates the necessity of Sheet References making the code easier to read and modify. Range Names are your Friend!

    As to your observation that more dialogs, like the one for Project No., would be a good idea is Right-On! Once again it would clean up the code not to mention that you can have multiple input fields in a single form (dialog) so that you could gather all the information for say one sheet in a single dialog and process it with the event code as I did with the Project No. and you basically have the user trapped until your code is happy with the data provided. You can even create the code so that it moves from dialog box to dialog box so the user never has to enter data directly into a sheet cell. Again IMHO the best way to do this sort of thing.

    One more thing about the Exit code it would be best to arrange all the fields for one sheet in order rather than jumping around from sheet to sheet.

    HTH

    P.S. Keep right on posting as you have more questions.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  18. #15
    Star Lounger
    Join Date
    Mar 2012
    Posts
    78
    Thanks
    20
    Thanked 0 Times in 0 Posts

    Exit Code Revised

    Hi RG

    I have started to clean up the exit code and I understand what I need to do to expand on the code titled--Private Sub Workbook_BeforeClose(Cancel As Boolean)--but how do I incorporate the pop-up form into the exit code? My original exit code worked with the pop-up form with the following code you provided:

    Code:
    Sheets("Cover").Range("H37").Select
        If Len(Trim(ActiveCell.Value)) = 0 Then
            ufProjEntry.Show
        End If
    I do not know how to rework this code into the new exit code?

    Jean

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •