Split Column Multiple Times

Splitting a column by a specified character to create two columns in necessary in Excel spreadsheets and VBA programming. Blanks, periods and commas are delimitors that can logically separates strings of data. A delimitor offen is specified many times.

This macro expidites splitting the currently active column by a specified character multiple times. The option to select the number of splits can be important. If the selectd number of splits is larger then the number of selected characters found in the entire column the macro ends. If the character delimitor is in the text selecting specifing a smaller number of splits to prevent the columns to be split by all of its delimitors may be helpful.

The delimitor must also be passed to this VBA macro.

This VBA macro can run interactively where the user specifices the number of splits and the character delimitor. The public macro variables DEFAULTVALUE1 and DEFAULTVALUE2 can be used to specifice the required parameters to prevent user interaction. Optional parameters could have been used but they would pervent the execution of the macro from the visual basic editor run command.

SAS Fifth Dimension Macro-Split column

%MACRO Sub SPLIT_COLUMN_MULT_TIMES() ;

Parameters are passed with a public macro variables:DEFAULTVALUE1 and DEFAULTVALUE2.

Options Description
Columns Column to split is the column of the active cell
Number of columns Number of times to split the columns. This is interactive if the public macro variables DEFAULTVALUE1 is blank The default value is 14.
Delimitor Character to split the columns. This is interactive if the public macro variables DEFAULTVALUE2 is blank. The default charater is a comma.

Assumption1: DEFAULTVALUE1 and DEFAULTVALUE2 are public macro variables.

Review the following code, copy it to Excel and execute it.

Sub SPLIT_COLUMN_MULTIPLE_TIMES()
    SUBNAME = "SplitColumnMultipleTimes"
    SELROW = ActiveCell.Row
    SELCOL_NUM = ActiveCell.Column
    If DEFAULTVALUE1 <> "" Then
       NUMTIMES = DEFAULTVALUE1
       DEFAULTVALUE1 = ""
    Else
       NUMTIMES = InputBox("Enter Number of columns" & Chr(10) & _
                    "Starting with columns " & SELCOL_NUM, SUBNAME, "14")
       If NUMTIMES = "" Then GoTo ENDIT
    End If
    If DEFAULTVALUE2 <> "" Then
       CHAR = DEFAULTVALUE2
       DEFAULTVALUE2 = ""
    Else
       CHAR = InputBox("Enter Character to split columns" & Chr(10) & _
                    "Starting with columns " & SELCOL_NUM, SUBNAME, ",")
       If CHAR = "" Then GoTo ENDIT
    End If
    For KK = 1 To NUMTIMES
        Cells(1, SELCOL_NUM + KK - 1).Select
        CURROW = ActiveCell.Row
        CURCOL = ActiveCell.Column
        Selection.SpecialCells(xlLastCell).Activate
        NUMROWS = ActiveCell.Row
        NUMCOLS = ActiveCell.Column
        Cells(CURROW, CURCOL).Select
        SUMPOS = 0
        For II = 1 To NUMROWS
            POS = InStr(Cells(II, CURCOL), CHAR)
            SUMPOS = SUMPOS + POS
            If Left(Cells(II, CURCOL), 1) = "=" _
            Then Cells(II, CURCOL) = Mid(Cells(II, CURCOL), 2)
            Cells(II, CURCOL) = Trim(Cells(II, CURCOL))
        Next
        If SUMPOS = 0 Then GoTo ENDIT
        SELCOL = NUMBER_TO_LETTERS(CURCOL + 1)
        Columns(SELCOL).Select
        Selection.Insert Shift:=xlToRight
        For II = 1 To NUMROWS
            POS = InStr(Cells(II, CURCOL), CHAR)
            If POS > 0 Then
               Cells(II, CURCOL + 1).Select
               Cells(II, CURCOL + 1) = Mid(Cells(II, CURCOL), POS + 1)
               Cells(II, CURCOL) = Left(Cells(II, CURCOL), POS - 1)
             End If
        Next
        BOTHCOLS = NUMBER_TO_LETTERS(CURCOL) & ":" & _
                   NUMBER_TO_LETTERS(CURCOL + 1)
        Columns(BOTHCOLS).Select
        Selection.Columns.AutoFit
        Cells(CURROW, CURCOL).Select    
    Next
    Cells(1, SELCOL_NUM).Select
ENDIT:
End Sub