VBA to adjust number value in a range

[Marklarbear]

Hi Brains Trust

I'm after 2 VBA codes that will do the following in a range of numbers:

VBA 1 - for any value that is 4 characters long, remove the first 2 characters and replace with '9'. ie in cell A2 it will change the value from 9008 to 908, in cell D5 it will change the value from 2399 to 999 and so on.

VBA 2 - for any value that is 2 characters long, add '1' to the start. ie in cell A7 it will change the value from 97 to 197, in cell C4 it will change the value from 32 to 132 and so on.


The end result will be that every cell in the range will have a 3 digit number in it (that will be greater than 100 and less than 1000).

As always - any help is greatly appreciated...

 

[kevin9999]

There's a number of ways you could do this, here's just a couple. Run the code with the sheet active & adjust the range to suit.
With Evaluate

Sub RoundNumsEvaluate()
    Dim rng As Range
    Set rng = Range("A1:D12")
    
    With rng
        .Value = Evaluate("IF(LEN(" & .Address & ")=4,""9""&RIGHT(" & .Address & ",2),IF(LEN(" & .Address & ")=2,""1""&RIGHT(" & .Address & ",2)," & .Address & "))")
    End With
End Sub

With arrays

Option Explicit
Sub RoundNumsArray()
    Dim a, b, i As Long, j As Long
    a = Range("A1:D12")
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    
    For i = 1 To UBound(a, 1)
        For j = 1 To UBound(a, 2)
            If Len(CStr(a(i, j))) >= 4 Then
                b(i, j) = "9" & Right(a(i, j), 2)
            ElseIf Len(CStr(a(i, j))) = 2 Then
                b(i, j) = "1" & Right(a(i, j), 2)
            Else
                b(i, j) = a(i, j)
            End If
        Next j
    Next i
    
    Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[Marklarbear]

There's a number of ways you could do this, here's just a couple. Run the code with the sheet active & adjust the range to suit.
With Evaluate

Sub RoundNumsEvaluate()
    Dim rng As Range
    Set rng = Range("A1:D12")
   
    With rng
        .Value = Evaluate("IF(LEN(" & .Address & ")=4,""9""&RIGHT(" & .Address & ",2),IF(LEN(" & .Address & ")=2,""1""&RIGHT(" & .Address & ",2)," & .Address & "))")
    End With
End Sub

With arrays

Option Explicit
Sub RoundNumsArray()
    Dim a, b, i As Long, j As Long
    a = Range("A1:D12")
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
   
    For i = 1 To UBound(a, 1)
        For j = 1 To UBound(a, 2)
            If Len(CStr(a(i, j))) >= 4 Then
                b(i, j) = "9" & Right(a(i, j), 2)
            ElseIf Len(CStr(a(i, j))) = 2 Then
                b(i, j) = "1" & Right(a(i, j), 2)
            Else
                b(i, j) = a(i, j)
            End If
        Next j
    Next i
   
    Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Cheers Kevin - i went with the Array option - your legend

 

[kevin9999]

Cheers Kevin - i went with the Array option - your legend

Happy to help, and thanks for the feedback