Help setting fixed values in an amazing macro that splits columns using dialog box feedback!

Mister_J

New Member
Joined
Dec 14, 2017
Messages
14
I have an amazing macro that uses dialog boxes and allows you to select a column of data, and break it up into multiple columns based on a number of rows you select. Then output those columns starting in a cell of your choosing.

Starts as: (I choose 2 rows per column)
1
2
3
4
5

Becomes:
1 3 5
2 4

The issue I am trying to solve is removing the dialog boxes and creating set values for the selections made in the dialog boxes.

I love the macro and use it regularly but I have one document that I archive frequently and I use the same settings each time. So does anyone know what part of the code I would need to alter to create a macro with fixed values?

*Ideally STARTING on cell A3 and selecting the rest of the column
Range(Selection, Selection.End(xlDown)).Select

*And ENDING by outputting in cell B3 then deleting (and shifting to the left) the original column selection (A3 and down).

Any and all help would be greatly appreciated! If I was unclear of you have questions please free to ask, Thanks!!!

Original Macro Code:
Sub SplitColumnVersion2()
'Updateby20191015
Dim rng As Range
Dim InputRng As Range
Dim OutRng As Range
Dim xRow As Integer
Dim xCol As Integer
Dim xArr As Variant
xTitleId = "Column Split"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
xRow = Application.InputBox("Rows (How many rows max per column) :", xTitleId)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set InputRng = InputRng.Columns(1)
xCol = InputRng.Cells.Count / xRow
ReDim xArr(1 To xRow, 1 To xCol + 1)
For i = 0 To InputRng.Cells.Count - 1
xValue = InputRng.Cells(i + 1)
iRow = i Mod xRow
iCol = VBA.Int(i / xRow)
xArr(iRow + 1, iCol + 1) = xValue
Next
OutRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,579
Office Version
2007
Platform
Windows
Try this

Code:
Sub SplitColumnVersion2()
  'Updateby20191015
  'Dim rng As Range
  Dim InputRng As Range, OutRng As Range
  Dim xRow As Integer, xCol As Integer, xArr As Variant
  Dim xValue, iRow, iCol, i As Long
  'xTitleId = "Column Split"
  'Set InputRng = Application.Selection
  Set InputRng = Range("A3", Range("A" & Rows.Count).End(xlUp))
  'Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
  'xRow = Application.InputBox("Rows (How many rows max per column) :", xTitleId)
  xRow = 2
  'Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
  Set OutRng = Range("B3")
  Set InputRng = InputRng.Columns(1)
  xCol = InputRng.Cells.Count / xRow
  ReDim xArr(1 To xRow, 1 To xCol + 1)
  For i = 0 To InputRng.Cells.Count - 1
    xValue = InputRng.Cells(i + 1)
    iRow = i Mod xRow
    iCol = VBA.Int(i / xRow)
    xArr(iRow + 1, iCol + 1) = xValue
  Next
  OutRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,579
Office Version
2007
Platform
Windows
I'm glad to help you. Thanks for the feedback.
 

Forum statistics

Threads
1,084,945
Messages
5,380,731
Members
401,696
Latest member
MDAUD

Some videos you may like

This Week's Hot Topics

Top