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

[Mister_J]

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]

Try this

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

 

[Mister_J]

You nailed it! Thank you!!!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.