Data cleaning temperature data where a value might be negative

[Aussiebear]

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?

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

[Aussiebear]

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?

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

[Aflatoon]

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

[georgiboy]

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

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

[Aussiebear]

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

[Paul_Hossler]

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

Capture.JPG

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

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

[jindon]

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

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

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

[Aussiebear]

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.