Is it possible to dynamically convert a number inside a cell string?

Viewed 80

I am trying to work on a dynamic converter in VBA that converts Inches to CM and so on, the issue is that the number will always be inside a cell string. For example I want to convert Dimensions: 8 x 2.6 x 0.9" to Dimensions: 20.32 x 6.6 x 2.28 cm. I have thought of several ways to do it but I can't figure it out. I have a function that extracts only the numbers from a cell string but it gets all the numbers and concatenates them.

Function GetNumeric(CellRef As String)
Dim StringLength As Integer
StringLength = Len(CellRef)
For i = 1 To StringLength
If IsNumeric(Mid(CellRef, i, 1)) Then Result = Result & Mid(CellRef, i, 1)
Next i
GetNumeric = Result
End Function

For example it takes 8 x 2.6 x 0.9 from the whole cell but it concatenates it to 82609. My usual delimiters are "x" or "by".

3 Answers

Try the next function, please:

Function StringToArray(x As String) As Variant
 Dim strArr As Variant
 
 If Right(x, 1) = Chr(34) Then
    strArr = Split(Replace(x, """", ""), " x ")
 Else
    strArr = Split(x, " x ")
 End If
 StringToArray = strArr
End Function

It can be used/called in this way:

Sub testStringToArray()
 Dim x As String, arr As Variant
 x = "8 x 2.6 x 0.9""" 'If the inch character exists in the string...
 x = "8 x 2.6 x 0.9"   'without " character
 arr = StringToArray(x)
 Debug.Print Join(arr, ",")
 Debug.Print arr(0), arr(1), arr(2)
 Debug.Print Round(CDbl(arr(0)) * 2.54, 2) & " x " & _
     Round(CDbl(arr(1)) * 2.54, 2) & " x " & Round(CDbl(arr(2)) * 2.54, 2) & " cm."
End Sub

You can process/convert each array element as you need...

As an non-VBA alternative, and you have Excel O365/2019 you could use:

=TEXTJOIN(" x ",,ROUND(CONVERT(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE(A1,"""","")," ","</s><s>")&"</s></t>","//s[.*0=0]"),"in","cm"),2))&" cm"

enter image description here

Note: On Excel2019 this may need to be entered through CtrlShiftEnter

Consider:

Public Function CentiMetre(s As String) As String
    Dim arr, L As Long, U As Long, i As Long
    
    arr = Split(s, " ")
    L = LBound(arr)
    U = UBound(arr)
    
    For i = L To U
        If IsNumeric(arr(i)) Then
            arr(i) = CStr(CDbl(arr(i)) * 2.54)
        End If
    Next i
    
    CentiMetre = Join(arr, " ")
End Function

enter image description here

NOTES:

  1. a space separator must be used between sub-strings
  2. only numbers are converted
  3. the cell can contain arbitrary text as well as numbers

EDIT#1:

This version will convert the double-quote into cm:

Public Function CentiMetre(s As String) As String
    Dim arr, L As Long, U As Long, i As Long, DQ As String
    
    DQ = Chr(34)
    arr = Split(Replace(s, DQ, ""), " ")
    L = LBound(arr)
    U = UBound(arr)
    
    For i = L To U
        If IsNumeric(arr(i)) Then
            arr(i) = CStr(CDbl(arr(i)) * 2.54)
        End If
    Next i
    
    CentiMetre = Join(arr, " ")
    If InStr(s, DQ) > 0 Then CentiMetre = CentiMetre & " cm"
End Function
Related