SOLVED

Normalizing a text with numbers

Copper Contributor

Hello,

i am looking for a fast ans simple (even VBA) solution to normalize text in a column.

Let's say i have column B with values in the pattern

A.9.1.1

What i want is every number to have two digits with a leading zero.

It is easy to replace .1. with .01. with a vba macro in a loop.

But the number at the end is difficult.

I can not replace .1 with .01 as for example A.10.01.1 would become to A.010.1.
You can see my problem?

Of course i could loop through each cell value, grab the text after teh last dot an check if it is one or two digits.

If it is one digit i can add the trailing zero.

Is this the only way or ist there some secret function that will do this for me faster?

6 Replies

@GKrembsler 

=LEFT(B8,SEARCH(".",B8)-1)&"."&TEXT(MID(B8,SEARCH(".",B8)+1,SEARCH(".",B8,SEARCH(".",B8)+1)-1-SEARCH(".",B8)),"00")&"."&TEXT(MID(B8,SEARCH(".",B8,SEARCH(".",B8)+1)+1,SEARCH(".",B8,SEARCH(".",B8,SEARCH(".",B8)+1)+1)-1-SEARCH(".",B8,SEARCH(".",B8)+1)),"00")&"."&TEXT(RIGHT(B8,LEN(B8)-SEARCH(".",B8,SEARCH(".",B8,SEARCH(".",B8)+1)+1)),"00")

Maybe with this formula. I've entered the formula in cell B12 and copied to the right.

format.JPG 

Tank you - this is the more manual way with a formula but not exactly what i am looking for.
Guess i did not make clear my intention ;)
I want to click on a button / start a macro, that is doing the work for me.
No problem to loop through every cell, get the value an change the last number after the last dot.
What i am looking for is a kind of "Function" doing this on a "search an replace" way.
Like having an RegEx expression.
But i guess it is really the simple way to loop through all cells.
This is my current Macro, in case it helps someone else ;)

Sub Normalize_Controls()
'
' Normalize_Controls Makro
'

'
For i = 1 To 9
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="." & i & ".", Replacement:=".0" & i & ".", LookAt:=xlPart,SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Next

For Each cel In Selection.Cells
TxTString = ""
FirstString = ""
LastString = ""
TxTString = cel.Text

FirstString = Left(TxTString, InStrRev(TxTString, "."))
LastString = Mid(TxTString, InStrRev(TxTString, ".") + 1, 999)

If Len(LastString) = 1 Then cel.Value = FirstString & "0" & LastString

Next cel

End Sub

@GKrembsler 

Sub AddLeadingZeros()
    Dim c As Range
    Dim s As String
    Dim i As Long
    Application.ScreenUpdating = False
    For Each c In Selection
        s = Replace(c.Value, ".", "..") & "."
        For i = 0 To 9
            s = Replace(s, "." & i & ".", ".0" & i & ".")
        Next i
        s = Replace(s, "..", ".")
        c.Value = Left(s, Len(s) - 1)
    Next c
    Application.ScreenUpdating = True
End Sub

 

best response confirmed by GKrembsler (Copper Contributor)
Solution

@GKrembsler 

Hi, see if this works. It presupposes the first char is always a letter and add zeroes for any number with length < 2. 

 

Sub AddLeadingZero()
'
' AddLeadingZero Macro
'
Dim numCodes() As Variant
Dim codeText() As String
Dim codeRange As Range

 

Set codeRange = Selection

numCodes = codeRange
For i = 1 To UBound(numCodes)
codeText = Split(numCodes(i, 1), ".")
For j = 1 To UBound(codeText)
If Len(codeText(j)) < 2 Then codeText(j) = "0" & codeText(j)
Next j
numCodes(i, 1) = Join(codeText, ".")
Next i
codeRange = numCodes

 

End Sub

 

Rsartori76_0-1657799292454.png

 

Here it is - my beloved split function i know from Script programming in HCL Notes. I just did not come to the idea to search for it in VBA documentation.
Thanks @ Rsartori76 - this is a much more elegant way to solve the problem.
Best wishes...
1 best response

Accepted Solutions
best response confirmed by GKrembsler (Copper Contributor)
Solution

@GKrembsler 

Hi, see if this works. It presupposes the first char is always a letter and add zeroes for any number with length < 2. 

 

Sub AddLeadingZero()
'
' AddLeadingZero Macro
'
Dim numCodes() As Variant
Dim codeText() As String
Dim codeRange As Range

 

Set codeRange = Selection

numCodes = codeRange
For i = 1 To UBound(numCodes)
codeText = Split(numCodes(i, 1), ".")
For j = 1 To UBound(codeText)
If Len(codeText(j)) < 2 Then codeText(j) = "0" & codeText(j)
Next j
numCodes(i, 1) = Join(codeText, ".")
Next i
codeRange = numCodes

 

End Sub

 

Rsartori76_0-1657799292454.png

 

View solution in original post