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

[TABLE="width: 360"]
<tbody>[TR]
[TD="width: 360"]PRODUCT DIMENSIONS ARE 305X1070X1625MM

I want to display in cell B2 C2 and D2

[TABLE="width: 217"]
<tbody>[TR]
[TD="width: 89, align: right"]B2
305[/TD]
[TD="width: 64, align: right"]C2
1070[/TD]
[TD="width: 64, align: right"]D2
1625
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
as you can see it is separating the sizes and ignoring the rest

so it shows this
[TABLE="width: 577"]
<colgroup><col style="text-align: center;"><col style="text-align: center;"><col span="2" style="text-align: center;"></colgroup><tbody>[TR]
[TD="align: center"]DESCRIPTION[/TD]
[TD="align: center"]DEPTH[/TD]
[TD="align: center"]LENGTH[/TD]
[TD="align: center"]HEIGHT[/TD]
[/TR]
[TR]
[TD="align: center"]PRODUCT DIMENSIONS ARE 305X1070X1625MM[/TD]
[TD="align: center"]305[/TD]
[TD="align: center"]1070[/TD]
[TD="align: center"]1625[/TD]
[/TR]
</tbody>[/TABLE]


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"

[TABLE="width: 448"]
<tbody>[TR]
[TD="width: 448"]MID FRAME 450 X 1500 X 1700MM

as an example [/TD]
[/TR]
</tbody>[/TABLE]

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