arrange within a cell

[ajith]

Hello,
Is it possible to arrange the multi-line contents within a single cell into columns

eg. if within a cell if it is like this
123445 ford ecospot
346 fiat
23 Nissan

We have to make it into, all the numbers one under the other and names one under the other within the same cell

 

[Rick Rothstein]

Is it possible to arrange the multi-line contents within a single cell into columns

We have to make it into, all the numbers one under the other and names one under the other within the same cell

If I understand what you want correctly, the following macro should work (it replaces the current contents of cell B38 with the text formatted so that each number or work line up under each other, but I can redirect the output to another cell if you need to retain the original). HOWEVER, for this to work, you must use a fixed-width font in order to guarantee the columns left align to each other. In the code, I chose to use Lucida Console as it looked similar to the Calibri font which is my default... however, you may use any fixed-width font you have on your system. Here is the macro...

Sub Align_Cell_B38()
  Dim R As Long, C As Long, MaxWordCount As Long, WordLen() As Long
  Dim T As String, W() As String, Words() As String, Lines() As String
  Lines = Split(Application.Trim(Range("B38").Value), vbLf)
  ReDim Words(0 To UBound(Lines), 0 To 0)
  ReDim WordLen(0 To 0)
  For R = 0 To UBound(Lines)
    W = Split(Lines(R))
    If UBound(W) > MaxWordCount Then
      MaxWordCount = UBound(W)
      ReDim Preserve Words(0 To UBound(Lines), 0 To MaxWordCount)
      ReDim Preserve WordLen(0 To MaxWordCount)
    End If
    For C = 0 To UBound(W)
      Words(R, C) = W(C)
      If Len(W(C)) > WordLen(C) Then WordLen(C) = Len(W(C))
    Next
  Next
  For R = 0 To UBound(Words)
    For C = 0 To UBound(Words)
      T = T & Format(Words(R, C), "!" & String(WordLen(C) + 2, "@"))
    Next
    T = T & vbLf
  Next
  T = Left(T, Len(T) - 1)
  With Range("B38")
    .Value = T
    .WrapText = True
    .Font.Name = "Lucida Console"
  End With
End Sub