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

Mister_J

New Member
Joined
Dec 14, 2017
Messages
20
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
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
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
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,267
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top