Separate dimensions is a string

[C Goody]

Hi All

Can someone help me out please I am am trying to create a formula to separate dimensions in a cell and display them in separate cells

example in Cell A2 it has

PRODUCT DIMENSIONS ARE 305X1070X1625MM I want to display in cell B2 C2 and D2 B2 305 C2 1070 D2 1625 <tbody> </tbody>

<tbody>
</tbody>

as you can see it is separating the sizes and ignoring the rest

so it shows this

DESCRIPTION	DEPTH	LENGTH	HEIGHT
PRODUCT DIMENSIONS ARE 305X1070X1625MM	305	1070	1625

<colgroup><col style="text-align: center;"><col style="text-align: center;"><col span="2" style="text-align: center;"></colgroup><tbody>
</tbody>

Hope thats makes sense and thanks all

 

[Rick Rothstein]

Hi Rick

can you add some code in where there is occasionally a space before and after the "x"

MID FRAME 450 X 1500 X 1700MM as an example

<tbody>
</tbody>

See if this modified macro does what you want...

[table="width: 500"]
[tr]
	[td]Sub GetDimensions()
  Dim R As Long, X As Long, Data As Variant, Dimensions As Variant, Parts As Variant
  Data = Range("A2", Cells(Rows.Count, "A").End(xlUp))
  ReDim Dimensions(1 To UBound(Data), 1 To 3)
  On Error Resume Next
  For R = 1 To UBound(Data)
    For X = 1 To Len(Data(R, 1))
      Data(R, 1) = Replace(Replace(Data(R, 1), " x", "x", , , vbTextCompare), "x ", "x", , , vbTextCompare)
      If Mid(Data(R, 1), X) Like "#[Xx]#*" Then
        Parts = Split(Trim(Mid(Data(R, 1), InStrRev(Data(R, 1), " ", X))), "x", , vbTextCompare)
        Dimensions(R, 1) = Parts(0)
        Dimensions(R, 2) = Val(Parts(1))
        Dimensions(R, 3) = Val(Parts(2))
      End If
    Next
  Next
  On Error GoTo 0
  Range("B2").Resize(UBound(Dimensions), 3) = Dimensions
End Sub[/td]
[/tr]
[/table]

 

[C Goody]

See if this modified macro does what you want...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub GetDimensions()
  Dim R As Long, X As Long, Data As Variant, Dimensions As Variant, Parts As Variant
  Data = Range("A2", Cells(Rows.Count, "A").End(xlUp))
  ReDim Dimensions(1 To UBound(Data), 1 To 3)
  On Error Resume Next
  For R = 1 To UBound(Data)
    For X = 1 To Len(Data(R, 1))
      Data(R, 1) = Replace(Replace(Data(R, 1), " x", "x", , , vbTextCompare), "x ", "x", , , vbTextCompare)
      If Mid(Data(R, 1), X) Like "#[Xx]#*" Then
        Parts = Split(Trim(Mid(Data(R, 1), InStrRev(Data(R, 1), " ", X))), "x", , vbTextCompare)
        Dimensions(R, 1) = Parts(0)
        Dimensions(R, 2) = Val(Parts(1))
        Dimensions(R, 3) = Val(Parts(2))
      End If
    Next
  Next
  On Error GoTo 0
  Range("B2").Resize(UBound(Dimensions), 3) = Dimensions
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Perfect. thank you very much for this Rick, it is appreciated