Data cleaning temperature data where a value might be negative

I'm currently working my way through a series of data tables showing minimum and Maximum values. The cell values are a mix of Temp values to 1 decimal point followed by the date.

for example 21.93rd, or 24.817th. and I need to clean the data by inserting a space and an opening parentheses after the 4th character, and a closing parentheses at the end of the string.


Later on down the table, the data boffins started throwing in some negative numbers just to test if I was paying attention. The following code should work shouldn't it?

Code:

---

Option Explicit


Sub AddParenthesesWithSpace()
    Dim rng As Range
    Dim cell As Range
    Dim strVal As String
    ' Set the range to B3:N27
    Set rng = ThisWorkbook.Sheets("Sheet3").Range("B3:N27")
    ' Loop through each cell in the range
    For Each cell In rng
        ' Get the string value from the cell
        strVal = cell.Value
        ' Check if the string has at least 4 characters and is positive or negative value
        If Len(strVal) >= 4 And Left(strVal) = "-" Then
            'Insert space and open parenthesis after the 5th Character
            strVal = Left(strVal, 5) & " (" & Mid(strVal, 6)
            ' Add closing parenthesis at the end
            strVal = strVal & ")"
            ' Update the cell value
            cell.Value = strVal
        Else
            ' Insert space and open parenthesis after the 4th character
            strVal = Left(strVal, 4) & " (" & Mid(strVal, 5)
            ' Add closing parenthesis at the end
            strVal = strVal & ")"
            ' Update the cell value
            cell.Value = strVal
        End If
    Next cell
    ' Clean up
    Set rng = Nothing
End Sub

---

Hmmmm.... scratch the above. In my haste of crossing eyes at the spreadsheet, I failed to notice that the minimums are occasionally single digit with one decimal place values, so the above code is useless if the value ranges between 9.9 and -9.9 in value. So would this be applicable?

Code:

---

Option Explicit


Sub AddParenthesesWithSpace()
    Dim rng As Range
    Dim cell As Range
    Dim strVal As String
    ' Set the range to B3:N27
    Set rng = ThisWorkbook.Sheets("Sheet3").Range("B3:N27")
    ' Loop through each cell in the range
    For Each cell In rng
        ' Get the string value from the cell
        strVal = cell.Value
        ' Check if the string has at least 4 characters and Smaller than -10.0
        If Len(strVal) >= 4 And Left(strVal) = "<=-10.0" Then
            'Insert space and open parenthesis after the 5th Character
            strVal = Left(strVal, 5) & " (" & Mid(strVal, 6)
            ' Add closing parenthesis at the end
            strVal = strVal & ")"
            ' Update the cell value
            cell.Value = strVal
        Elseif

            ' Insert space and open parenthesis after the 4th character
            strVal = Left(strVal, 4) & " (" & Mid(strVal, 5)
            ' Add closing parenthesis at the end
            strVal = strVal & ")"
            ' Update the cell value
            cell.Value = strVal
        End If
    Next cell
    ' Clean up
    Set rng = Nothing
End Sub

---

Use Instr to find the decimal point and then go 1 right from there?

I would split by the decimal and then join it all back together again using left and right:

Code:

---

Sub Test()
    Dim rRng As Range, rCell As Range, rVar As Variant, r As String
   
    Set rRng = Sheets("Sheet3").Range("B3:N27")
   
    For Each rCell In rRng
        rVar = Split(rCell, ".")
        r = rVar(1)
        rCell = rVar(0) & "." & Left(r, 1) & " (" & Right(r, Len(r) - 1) & ")"
    Next rCell
End Sub

---

Thank you. Seems I was chasing possums up a non existent tree with my effort.

Quote:

---

I need to clean the data by inserting a space and an opening parentheses after the 4th character, and a closing parentheses at the end of the string.

---

If it were me, I'd consider putting the temp in one column and the date made into a real Excel date in another

Attachment 31899

I think having the pieces separated would provide more flexibility

Personally, I like to use array entered UDFs, but you could include the code in a sub for a once-and-done.

Only problem (and it might make this not usable) is the date part lacks a month, so I just said that if it's larger than today, it must be last month

But it was an interesting question in any event

Code:

---

Option Explicit


Function SplitTempDate(s As String) As Variant
    Dim A(0 To 1) As Variant
    Dim V As Variant
    Dim d As Long, m As Long, y As Long
   
    's = -12.34th
    V = Split(s, ".")  '(0) = -12 (1) = 34th
   
    A(0) = CDbl(V(0) & "." & Left(V(1), 1))  '  =  -12.3
    A(1) = CDbl(Mid(V(1), 2, Len(V(1)) - 3)) '  =  4
   
    d = Day(Now)
    m = Month(Now)
    y = Year(Now)
   
    'if A(1) > today then it must be last month
    If A(1) > d Then
        A(1) = DateSerial(y, m - 1, A(1))
    Else
        A(1) = DateSerial(y, m, A(1))
    End If
   
    SplitTempDate = A
End Function

---

I would use Regula Expression.
If the RegEx functions are available in your version.

Code:

---

Sub test()
    With ThisWorkbook.Sheets("Sheet3").Range("B3:N27")
        .Value = .Parent.[regexreplace(b3:n27,"(\d+\.\d)(\d{1,2}(st|nd|rd|th))$","$1 ($2)")]
    End With
End Sub

---

Otherwise

Code:

---

Sub test()
    Dim a, i&, ii&
    With ThisWorkbook.Sheets("Sheet3").Range("B3:N27")
        a = .Value
        With CreateObject("VBScript.RegExp")
            .Pattern = "(\-?\d+\.\d)(\d{1,2}(st|nd|rd|th))$"
            For i = 1 To UBound(a, 1)
                For ii = 1 To UBound(a, 2)
                    If .test(a(i, ii)) Then a(i, ii) = .Replace(a(i, ii), "$1 ($2)")
                Next
            Next
        End With
        .Value = a
    End With
End Sub

---

Thank you Paul & Jindon.

Paul, the BOM website has the table with months as a Header per column. Current intention is just to seperate with a space. When I create a new table I will give both of your methods a run.