Need a Macro / VBA to find numbers in a text string and add a thousands comma

[chicolocal]

I have had no luck finding a solution to my problem but am confident it can be done... My cell contents are formatted as text and some contain numbers, some do not, some already contain thousands separators, others do not. Here is an example:

Speed: 20000

Free Speed: 120000

Spindle Speed: 15,000

Voltage: 115V/230V

Motor HP: 1-1/5

If the macro were applied to a selection containing the above examples, I would like for it to only update the number values in 'Speed' and 'Free Speed' to 20,000 and 120,000 respectively. Any suggestions? Thanks in advance and happy holidays!

[patel45]

attach a sample file

[quanghai]

Why dont you try this code to see if this can clear your problem? Please give your feedback.

Sub test()
Dim temp, i, result
temp = Range([A1], [A65536].End(3)).Value
For i = 1 To UBound(temp)
   With CreateObject("vbscript.regexp")
      .Global = True
      .Pattern = ".* "
      result = .Replace(temp(i, 1), "")
      If IsNumeric(result) Then
         result = Format(result, "#,###")
         temp(i, 1) = Left(temp(i, 1), InStrRev(temp(i, 1), " ")) & result
      End If
   End With
Next
[A1].Resize(i - 1, 1) = temp
End Sub 

Below is another solution to your problem

Sub test2()
Dim Stemp(), temp, result, i
Stemp = Range([A1], [A65536].End(3)).Value
For i = 1 To UBound(Stemp)
   With CreateObject("vbscript.regexp")
      .Global = True
      .Pattern = "\d+"
      Set temp = .Execute(Stemp(i, 1))
       For Each result In temp
         If result > 999 Then
            Stemp(i, 1) = Replace(Stemp(i, 1), result, Format(result, "#,###"))
         End If
       Next
   End With
Next
[A1].Resize(i - 1, 1) = Stemp
End Sub 

[chicolocal]

Hi quanghai, thanks for your post. Unfortunately the macro didn't seem to change any of the values in my worksheet. I have attached a sample file. Thanks in advance!

[quanghai]

Hi quanghai, thanks for your post. Unfortunately the macro didn't seem to change any of the values in my worksheet. I have attached a sample file. Thanks in advance!

Hi. I tested the code and the result is as what you need. Please take a look at the attached file

[chicolocal]

Thanks quanghai!!! I didn't notice until now that the code only made changes to column A and was looking for the change in other columns. I have edited it to work for my selection and it works perfect. Much appreciated!

[chicolocal]

I am having trouble editing the macro to apply to the selected cells on the active sheet. Any advice?

[Leith Ross]

Hello chicolocal,

Which macro are you using Test or Test2?
Are you manually selecting cells on the worksheet?
Are the cells all contiguous (touching each other)?

[chicolocal]

Works perfect! Thanks

[chicolocal]

I am using the Test2 macro and yes, the cells are contiguous.

[Leith Ross]

Hello chicolocal,

Here is the updated macro...

Sub Test2a()

    Dim i As Long, j As Long
    Dim RegExp As Object
    Dim Stemp(), temp As Object, result As Variant
    
        Stemp = Selection.Value
        
        Set RegExp = CreateObject("vbscript.regexp")
        RegExp.Global = True
        RegExp.Pattern = "\d+"
        
        For i = 1 To UBound(Stemp, 1)
            For j = 1 To UBound(Stemp, 2)
                Set temp = RegExp.Execute(Stemp(i, j))
                For Each result In temp
                    If result > 999 Then
                        Stemp(i, j) = Replace(Stemp(i, j), result, Format(result, "#,###"))
                    End If
                Next result
            Next j
        Next i
        
        Selection.Value = Stemp
        
End Sub