Split Cell values

[mijaz]

I have following data in each cell of Column D; for example cell D1 contains:

1
2
3
4
5
Above are the values in D1, similar data exists from D1 to D10000. I need to split these values into adjacent empty columns(cells). Text to columns does not work here because separating value is Alt+Enter which Text to Columns does not recognize. I probably need some VBA code for this. And need your help in this regard.

 

[Peter_SSs]

.. press CTRL+J instead...

Ah, I thought there was another method like that but couldn't recall it. Thanks for the reminder Rick.

 

[mijaz]

Thanks a lot for doing this favor. It was really great.


Though I have another query. There are two columns. Column A and B. Column A has numerics. Column B has values against it. There are upto 10 values against one number in different rows i.e.

Column A column B
A1= 1 B1= Pakistan
A2= Blank B2= India
A3=Blank B3= Indonesia

etc.

I wish to transfer Column B values in Column C1, D1, E1, F1. I mean upto the number of values against cell A1. Is it possible? In other words i want this data in one row. Kindly help.

 

[Rick Rothstein]

Does this code do what you want...

Sub TransposeDataAcross()
  Dim LastRow As Long, Blanks As Range, Ar As Range
  Const StartRow As Long = 1
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  Set Blanks = Cells(StartRow, "A").Resize(LastRow - StartRow + 1).SpecialCells(xlCellTypeBlanks)
  For Each Ar In Blanks.Areas
    Ar(1).Offset(-1, 2).Resize(, Ar.Rows.Count) = WorksheetFunction.Transpose(Ar.Offset(, 1))
  Next
  Blanks.EntireRow.Delete
End Sub

 

[mijaz]

Thanks very much dear.

One last query please i.e.


If a cell is blank in Column A, then copy the data from above cell and paste it in the blank cell.

 

[Rick Rothstein]

One last query please i.e.

If a cell is blank in Column A, then copy the data from above cell and paste it in the blank cell.

Give this macro a try...

Sub FillBlanks()
  Dim LastRow As Long
  Const StartRow As Long = 2
  LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, _
            SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  With Cells(StartRow, "A").Resize(LastRow - StartRow + 1)
    .SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
  End With
End Sub