Cell Formatting

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
609
Good Morning,

I need to format a few different cells in the following manners:

A1 has to always add a colon :)) after whatever is typed in by a user. Example- "F" in a cell becomes "F:"

A2 has to always be three digits- so if a user puts in "1", the cell shows "001" or if a user puts in "20" it shows as "020" and obviously a three digit number like "340" just stays "340".

A3 has to add an "'ly" to all single letter input codes. So a user might put in W 3, W-3, or W3 and I want it to show as "W'ly 3". However, sometimes the user might use NW 3, NW3, or NW3 and those should just format as "NW 3". So in conclusion, anytime a single letter (and number) are used, the letter should have "'ly" added to it and one space between the "'ly" and the number. And anytime two letters are used, they should just ensure there is a space between the two letter code and the number.

Thanks!
 

Paul Ked

Active Member
Joined
Jun 4, 2015
Messages
441
In the Worksheet code module:

Code:
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim a3 As String
    If Target.Address = ("$A$1") Then
        If Right([a1], 1) <> ":" Then [a1] = [a1] & ":"
    End If
    If Target.Address = ("$A$2") Then
        Range("A2").NumberFormat = "@"
        If Len([a2]) = 1 Then [a2] = "00" & [a2]
        If Len([a2]) = 2 Then [a2] = "0" & [a2]
    End If
    If Target.Address = ("$A$3") Then
        a3 = Range("A3")
        If Mid(a3, 2, 1) Like "[a-zA-Z]" Then
            a3 = Left(a3, 2) & " " & Right(a3, 1)
            Range("A3") = a3
        Else
            a3 = Left(a3, 1) & "'ly " & Right(a3, 1)
            Range("A3") = a3
        End If
    End If
    Application.EnableEvents = True
End Sub
 
Last edited:

Paul Ked

Active Member
Joined
Jun 4, 2015
Messages
441
If you want to force uppercase in A1 and A3 (excluding the 'ly) then:

Code:
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim a3 As String
    If Target.Address = ("$A$1") Then
        If Right([a1], 1) <> ":" Then [a1] = [COLOR=#ff0000]UCase([a1] & ":")[/COLOR]
    End If
    If Target.Address = ("$A$2") Then
        Range("A2").NumberFormat = "@"
        If Len([a2]) = 1 Then [a2] = "00" & [a2]
        If Len([a2]) = 2 Then [a2] = "0" & [a2]
    End If
    If Target.Address = ("$A$3") Then
        a3 = Range("A3")
        If Mid(a3, 2, 1) Like "[a-zA-Z]" Then
            a3 = Left(a3, 2) & " " & Right(a3, 1)
            Range("A3") = UCase(a3)
        Else
            a3 = [COLOR=#ff0000]UCase(Left(a3, 1))[/COLOR] & "'ly " & Right(a3, 1)
            Range("A3") = a3
        End If
    End If
    Application.EnableEvents = True
End Sub
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,442
Office Version
2010
Platform
Windows
Here is another way to write the Change event procedure...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim IsDigit As Boolean
  Application.EnableEvents = False
  If Target.Address(0, 0) = "A1" Then
    [A1] = [IF(RIGHT(A1)<>":",A1&":",A1)]
  ElseIf Target.Address(0, 0) = "A2" Then
    [A2].NumberFormat = "000"
  ElseIf Target.Address(0, 0) = "A3" Then
    IsDigit = Mid(Replace([A3], " ", ""), 2, 1) Like "#"
    [A3] = Application.Replace(Replace([A3], " ", ""), 3 + IsDigit, 0, Choose(2 + IsDigit, "'ly ", " "))
  End If
  Application.EnableEvents = True
End Sub
 

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
609
Well let's try posting again!

Ok- I tried both methods in with a whole slew of other stuff I have in the worksheet_change coding.

Neither seem to have worked and I'm not sure why. In the sheet, for this particular case, D12 = R11 where R11 is where the user can input data and D12 is where it shows up (in a locked-cell that's formatted to look nice). Sheet is named "Noon". Both iterations of code are in red.

Note: I've cleaned out some stuff just to shorten this code- nothing removed was important

Rich (BB code):
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)On Error GoTo Helper
If sh.name = "Notes" _
    Or sh.name = "Ports" _
    Or sh.name = "Voyage Specifics" _
    Then Exit Sub
Dim isdigit As Boolean 'this is the weather direction "'ly's"


With Application
    .EnableEvents = False
    .ScreenUpdating = False
If sh.name = "Developer" Then
    If Target.Address = "E42" Then
        If Right([e42], 1) <> ":" Then [e42] = UCase([e42] & ":")
    End If
    If Target.Address = "J48" Then
        If Right([j48], 1) <> ":" Then [j48] = UCase([j48] & ":")
    End If
    Exit Sub
End If


If Target.Address(0, 0) = "R5" Or Target.Address(0, 0) = "W25" Then
    If Cells(25, 23) <> "" Then
        Cells(4, 6) = Cells(25, 23).Value
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) <> "" And Cells(25, 23) = "" Then
        Cells(4, 6) = Date
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) = "" And Cells(6, 23) = "" Then
        Cells(4, 6) = "No Data Input"
    End If
If Target.Address = ("N5") Then
    Range("N5").NumberFormat = "@"
    If Len([n5]) = 1 Then [n5] = "00" & [n5]
    If Len([n5]) = 2 Then [n5] = "0" & [n5]
End If
 
If Target.Address(0, 0) = ("$D$12") Then
    d12 = Range("D12")
    If Mid(d12, 2, 1) Like "[a-zA-Z]" Then
        d12 = Left(a3, 2) & " " & Right(d12, 1)
        Range("D12") = UCase(d12)
    Else
        d12 = UCase(Left(d12, 1)) & "'ly " & Right(d12, 1)
        Range("D12") = d12
    End If
End If


If Target.Address(0, 0) = "R11" Then
    isdigit = Mid(Replace([R11], " ", ""), 2, 1) Like "#"
    [R11] = Application.Replace(Replace([R11], " ", ""), 3 + isdigit, 0, Choose(2 + isdigit, "'ly ", " "))
  End If
            
  If sh.name = "Arrival" Then
        If Cells(20, 26) <> "Yes" Then
            Range("R6").Select
            With Selection
                ***Formatting code***
             End With
        ElseIf Cells(20, 26) <> "No" Then
            Cells(6, 18) = "EXACT"
            Range("R6").Select
            With Selection
             ***Formatting code***
            End With
            Range("R7").Select
        End If
    ElseIf Cells(20, 26) <> "Yes" Then
        Range("R9").Select
            With Selection
                ***Formatting code***
            End With
            Range("R6").Select
    ElseIf Cells(20, 26) <> "No" Then
        Cells(9, 18) = "EXACT"
        Range("R9").Select
            With Selection
               ***Formatting code***
            End With
        Range("R6").Select
    End If
End If


    .EnableEvents = True
    .ScreenUpdating = True


End With


'Error Clearing Code
Exit Sub
Helper:
***ERROR CODING***
        
End Sub
 

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
609
So I quickly realized my error here- all of my code above is in the ThisWorkbook section...not the individual sheet. How would you go about tweaking it to work in the ThisWorkbook section? My thoughts- my workbook has buttons that dynamically add/delete sheets as required. The sheets that this would need to affect are all added/removed by the user- they aren't the "fixed" sheets- so unless this was written into my sheet-creation coding, they would be deleted during first use.
 

Paul Ked

Active Member
Joined
Jun 4, 2015
Messages
441
So basically you asked the wrong question in the beginning.
 

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
609
So basically you asked the wrong question in the beginning.
Hmm. I don't think so. How would you change your code so that it can be used in the ThisWorkbook section instead of the individual sheet's section? That way, it can be applied to all of the sheets in the workbook? It's unfortunately not as easy as just changing the worksheet_change to workbook_change.....
 
Last edited:

Paul Ked

Active Member
Joined
Jun 4, 2015
Messages
441
In the This Workbook code module

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name <> "Sheet1" Then Exit Sub
    Application.EnableEvents = False
    Dim a3 As String
    If Target.Address = ("$A$1") Then
        If Right([A1], 1) <> ":" Then [A1] = UCase([A1] & ":")
    End If
    If Target.Address = ("$A$2") Then
        Range("A2").NumberFormat = "@"
        If Len([A2]) = 1 Then [A2] = "00" & [A2]
        If Len([A2]) = 2 Then [A2] = "0" & [A2]
    End If
    If Target.Address = ("$A$3") Then
        a3 = Range("A3")
        If Mid(a3, 2, 1) Like "[a-zA-Z]" Then
            a3 = Left(a3, 2) & " " & Right(a3, 1)
            Range("A3") = UCase(a3)
        Else
            a3 = UCase(Left(a3, 1)) & "'ly " & Right(a3, 1)
            Range("A3") = a3
        End If
    End If
    Application.EnableEvents = True
End Sub
 

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
609
Worked perfectly. Little tweaking to get into my workbook but the basis for the code was perfect! Thanks!
 

Forum statistics

Threads
1,078,548
Messages
5,341,099
Members
399,419
Latest member
Lucullus

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top