# Need a VBA code to round alphanumeric key



## Siddhu11011 (Dec 29, 2022)

I'm having below output by applying formulas. 
TAT  20221208A5364.99999956
SP  20221106D1256.00075

I need to round above 2 output as given below
TAT  20221208A5365
SP  20221106D1256

Note: I have other output in a column without any decimals so find first only cells with decimals

Thanks for reading my query and would be happy if you can help me.


----------



## lrobbo314 (Dec 29, 2022)

How about this?

REAB1TAT 20221208A5364.99999956TAT 20221208A53652SP 20221106D1256.00075SP 20221106D1256Sheet1Cell FormulasRangeFormulaB1:B2B1=ROUNDPART(A1)


```
Function ROUNDPART(s As String)
Dim f As String

With CreateObject("VBScript.RegExp")
    .Pattern = "\d+\.\d+"
    f = .Execute(s)(0)
    s = .Replace(s, "")
    ROUNDPART = s & Round(f, 0)
End With
End Function
```


----------



## Siddhu11011 (Dec 29, 2022)

lrobbo314 said:


> How about this?
> 
> REAB1TAT 20221208A5364.99999956TAT 20221208A53652SP 20221106D1256.00075SP 20221106D1256Sheet1Cell FormulasRangeFormulaB1:B2B1=ROUNDPART(A1)
> 
> ...


When I apply this UDF and drag down then it`s giving me an error for cells without having any decimal places.
Ex. I have text string in other cells such as GUM 20221208A1259 (Without decimal)
Could you please resolve that
Is it possible for you to make Macro to search cells (In column BH) with decimal and then apply solution


----------



## lrobbo314 (Dec 29, 2022)

How about this then?  

ExcelAB1TAT 20221208A5364.99999956TAT 20221208A53652SP 20221106D1256.00075SP 20221106D12563GUM 20221208A1259GUM 20221208A1259Sheet1

The code assumes that your data starts in A1, and it will output the results to column B.  Just run the 'Main' subroutine.


```
Sub Main()
Dim r As Range:         Set r = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2

For i = 1 To UBound(AR)
    If InStr(AR(i, 1), ".") > 0 Then AR(i, 1) = RPNV(CStr(AR(i, 1)))
Next i

r.Offset(, 1).Value2 = AR
End Sub

Function RPNV(s As String)
Dim b() As Byte:    b = s
Dim POS As Integer
Dim tmp As String

For i = UBound(b) - 1 To LBound(b) Step -2
    If b(i) >= 65 And b(i) <= 90 Then POS = (i / 2) + 1: Exit For
Next i

RPNV = Left(s, POS) & Round(Right(s, Len(s) - POS), 0)
End Function
```


----------



## lrobbo314 (Dec 29, 2022)

I see that you're working with Excel 2013.  If you upgrade and get the dynamic array formulas, you could do it all with formulas like this.

ExcelAB1TAT 20221208A5364.99999956TAT 20221208A53652SP 20221106D1256.00075SP 20221106D12563GUM 20221208A1259GUM 20221208A1259Sheet1Cell FormulasRangeFormulaB1:B3B1=RAK(A1:A3)Dynamic array formulas.

The first lambda finds the first uppercase letter.  The optional [reverse] argument allows you to go from right to left instead of left to right.

*FIRSTALPHA*

```
=LAMBDA(
    range,[reverse],
    MAP(range,
        LAMBDA(
            t,
            LET(
                s,SEQUENCE(LEN(t)),
                m,CODE(MID(t,s,1)),
                f,FILTER(s,(m>59)*(m<91)),
                IF(reverse,
                    MAX(f),
                    MIN(f)
                )
            )
        )
    )
)
```

The second lambda includes the first one.

*RAK*

```
=LAMBDA(
    range,
    MAP(range,
        LAMBDA(
            x,
            LET(
                f,FIRSTALPHA(x,1),
                    LEFT(x,f)&ROUND(RIGHT(x,LEN(x)-f),0)
            )
        )
    )
)
```


----------



## Siddhu11011 (Dec 30, 2022)

lrobbo314 said:


> How about this then?
> 
> ExcelAB1TAT 20221208A5364.99999956TAT 20221208A53652SP 20221106D1256.00075SP 20221106D12563GUM 20221208A1259GUM 20221208A1259Sheet1
> 
> ...


Not working properly although earlier problem got resolved and thanks for that
Try above code for this key 4NNN  251010C03325329.999999999927
It gives output as 4NNN  251010C3325330. It removes zero post alphabet "C".
Can you just help me with that?


----------



## Phuoc (Dec 30, 2022)

Try this


```
Public Function RoundID(ByVal s As String) As String
Dim k&, i&, t&, j&
k = InStr(1, s, ".")
If k = 0 Then
    RoundID = s
Else
    t = Mid(s, k + 1, 1)
    s = Left(s, k - 1)
    If t < 5 Then
        RoundID = s
    Else
        For i = k - 1 To 1 Step -1
            If IsNumeric(Mid(s, i, 1)) = False Then Exit For
        Next i
        RoundID = Left(s, i) & Format(Mid(s, i + 1) + 1, String(k - i - 1, "0"))
              
    End If
End If
End Function
```


----------



## Siddhu11011 (Dec 30, 2022)

Phuoc said:


> Try this
> 
> 
> ```
> ...


Thanks for your suggestion but I need it in form of VBA macro instead of UDF. Although your UDF is working well. My input data is in column BH and I`m expecting output in column BI once I run the macro. It would be delightful if you can help.


----------



## Siddhu11011 (Dec 30, 2022)

Siddhu11011 said:


> Thanks for your suggestion but I need it in form of VBA macro instead of UDF. Although your UDF is working well. My input data is in column BH and I`m expecting output in column BI once I run the macro. It would be delightful if you can help.


I have decided to use it as UDF. Thanks for your help. Means a lot......Great day


----------



## lrobbo314 (Dec 30, 2022)

This fixes the issue from post #6.


```
Sub MAIN()
Dim r As Range:         Set r = Range("BH1:BH" & Range("BH" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant:    AR = r.Value2

For i = 1 To UBound(AR)
    If InStr(AR(i, 1), ".") > 0 Then AR(i, 1) = RPNV(CStr(AR(i, 1)))
Next i

r.Offset(, 1).Value2 = AR
End Sub

Function RPNV(s As String)
Dim b() As Byte:    b = s
Dim POS As Integer
Dim tmp As String
Dim rNum As String

For i = UBound(b) - 1 To LBound(b) Step -2
    If b(i) >= 65 And b(i) <= 90 Then POS = (i / 2) + 1: Exit For
Next i

tmp = Right(s, Len(s) - POS)
rNum = Round(tmp, 0)

RPNV = Left(s, POS) & String(InStr(tmp, ".") - 1 - Len(rNum), "0") & rNum
End Function
```


----------



## Siddhu11011 (Dec 29, 2022)

I'm having below output by applying formulas. 
TAT  20221208A5364.99999956
SP  20221106D1256.00075

I need to round above 2 output as given below
TAT  20221208A5365
SP  20221106D1256

Note: I have other output in a column without any decimals so find first only cells with decimals

Thanks for reading my query and would be happy if you can help me.


----------



## Rick Rothstein (Dec 30, 2022)

Basically, the same underlying logic as Phuoc's UDF , but more compactly presented...

```
Function RoundID(ByVal S As String) As String
  Dim X As Long, Num As String
  S = " " & S
  For X = Len(S) To 1 Step -1
    If Mid(S, X, 1) Like "[!0-9.]" Then
      Num = Mid(S, X + 1)
      RoundID = Trim(Left(S, X)) & Format(Num, String(InStr(Num & ".", ".") - 1, "0"))
      Exit For
    End If
  Next
End Function
```


----------



## Phuoc (Dec 31, 2022)

If the value is 1.5:

 the result of RoundID of post #7 is 2

the result of RoundID of post #11 is empty.


----------



## Rick Rothstein (Dec 31, 2022)

Phuoc said:


> If the value is 1.5:
> 
> the result of RoundID of post #7 is 2
> 
> the result of RoundID of post #11 is empty.


Good catch! I edited the code in Message #11 to fix this issue. Thanks for catching it.


----------

