Question

I have have the following data in excel:

a, b, c d e f, g h i 

with each row, representing a row and in one cell.

I would like to convert it to:

a b c d e f g h i 

I am using the following macro, but I can’t get the autosize to do an insert, instead of overriding the cell values. Any help is appreciated.

    Sub SplitCells()       Dim i As Long        With Application          .Calculation = xlCalculationManual          .ScreenUpdating = False         For i = 1 To Selection.Rows.Count          Dim splitValues As Variant           splitValues = split(Selection.Rows(i).Value, ',')          Selection.Rows(i).Resize(UBound(splitValues) - LBound(splitValues) + 1).Value = Application.Transpose(splitValues)      Next i            .Calculation = xlCalculationAutomatic          .ScreenUpdating = True      End With  End Sub 

Answer 1

This macro will take your data from column A and ‘extract’ it to column B. The results are shown below, feel free to cower at my graphical presentation skills 🙂

    <- A ->   <- B -> 1   a, b, c   a 2   d         b 3   e         c 4   f, g      d 5   h         e 6   i         f 7             g 8             h 9             i 

I’ve left it as non-destructive for testing purposes, and since it’s relatively easy to create a new column, populate it and delete the old column in VBA. An exercise for the reader…

Here is the macro:

Option Explicit Sub Macro1()     Dim fromCol As String     Dim toCol As String     Dim fromRow As String     Dim toRow As String     Dim inVal As String     Dim outVal As String     Dim commaPos As Integer      ' Copy from column A to column B.'     fromCol = 'A'     toCol = 'B'     fromRow = '1'     toRow = '1'      ' Go until no more entries in column A.'     inVal = Range(fromCol + fromRow).Value     While inVal <> ''          ' Go until all sub-entries used up.'         While inVal <> ''             Range(fromCol + fromRow).Select              ' Extract each subentry.'             commaPos = InStr(1, inVal, ',')             While commaPos <> 0                  ' and write to output column.'                 outVal = Left(inVal, commaPos - 1)                 Range(toCol + toRow).Select                 Range(toCol + toRow).Value = outVal                 toRow = Mid(Str(Val(toRow) + 1), 2)                  ' Remove that sub-entry.'                 inVal = Mid(inVal, commaPos + 1)                 While Left(inVal, 1) = ' '                     inVal = Mid(inVal, 2)                 Wend                 commaPos = InStr(1, inVal, ',')             Wend              ' Get last sub-entry (or full entry if no commas).'             Range(toCol + toRow).Select             Range(toCol + toRow).Value = inVal             toRow = Mid(Str(Val(toRow) + 1), 2)             inVal = ''         Wend          ' Advance to next source row.'         fromRow = Mid(Str(Val(fromRow) + 1), 2)         Range(fromCol + fromRow).Select         inVal = Range(fromCol + fromRow).Value     Wend End Sub