Cell Formatting

[sassriverrat]

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]

In the Worksheet code module:

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

 

[Paul Ked]

If you want to force uppercase in A1 and A3 (excluding the 'ly) then:

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]

Here is another way to write the Change event procedure...

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 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

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]

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]

So basically you asked the wrong question in the beginning.

 

[sassriverrat]

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.....

 

[Paul Ked]

In the This Workbook code module

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]

Worked perfectly. Little tweaking to get into my workbook but the basis for the code was perfect! Thanks!