Combine three InputBoxes into one?

[L. Howard]

Using three inputboxes this code works okay. Takes a column from sheet 1 and makes shorter columns on sheet 2

I would like to do two things.

1. Combine all three entries to a single inputbox, say comma delimited.
2. When referring to the source and destination columns use a letter. (Code below uses a letter for Source and a "number - 1" for Destination column.)

Then split the inputboxes entries to the variables.

Where an inputbox entry would look like 10,D,F would be:

10 rows at a time from column D on source sheet column, post to destination sheet starting at column F and to the right. If last column is not a full 10 rows that is ok.

Thanks.
Howard

Sub ColumnToColumns()

Dim wks1 As Worksheet, wks2 As Worksheet
Dim iColumn As Integer
Dim lLast As Long
Dim i As Long, j As Long ', y As Long
Dim DestCol As String
Dim nRows As String
Dim nnCols As String
Dim nCols As String

nRows = InputBox("Colum No. of Rows.", "Enter value")
If nRows = vbNullString Then Exit Sub

nCols = InputBox("Colum A to Column ?", "Enter Column Letter")
If nCols = vbNullString Then Exit Sub

DestCol = Application.InputBox("Destination Colum 1 = A, 26 = Z ?", "Enter Destination Column number", , , , , , 1)
If DestCol = vbNullString Then Exit Sub

nnCols = nRows - 1

Application.ScreenUpdating = False

Set wks1 = Worksheets("Sheet2") '/ Rename to your workbook
Set wks2 = Worksheets("Sheet3") '/ Rename to your workbook

lLast = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row

j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + (DestCol - 1)

For iColumn = 1 To nRows
lLast = Application.Max(lLast, wks1.Cells(wks1.Rows.Count, _
iColumn).End(xlUp).Row)
Next iColumn

For i = 1 To lLast Step nRows
wks1.Range(nCols & i & ":" & nCols & i + nnCols).Copy wks2.Cells(1, j)
j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + 1

' To cut data to sheet 2
'wks1.Range(nCols & i & ":" & nCols & i + nnCols).Cut wks2.Cells(1, j)
'j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + 1

Next

wks2.Activate
Columns("A:Z").HorizontalAlignment = xlCenter
Application.Columns("A:Z").AutoFit

wks1.Activate
Set wks1 = Nothing
Set wks2 = Nothing

Application.ScreenUpdating = True
End Sub

 

[Claus Busch]

Hi Howard,

Am Sat, 24 May 2014 06:05:08 -0700 (PDT) schrieb L. Howard:

1. Combine all three entries to a single inputbox, say comma delimited.
2. When referring to the source and destination columns use a letter. (Code below uses a letter for Source and a "number - 1" for Destination column.)

try:

Sub TransformCol()
Dim Info As String
Dim LRow As Long, i As Long, j As Long
Dim arrOut As Variant
Dim arrInfo As Variant

Info = Application.InputBox("Enter the number of rows," _
& "the source column and the target column comma separated",
"Infos", _
Type:=2)

arrInfo = Split(Info, ",")

With Sheets("Sheet2")
LRow = .Cells(Rows.Count, arrInfo(1)).End(xlUp).Row
For i = 1 To LRow Step arrInfo(0)
arrOut = .Range(.Cells(i, UCase(arrInfo(1))), _
.Cells(i + arrInfo(0) - 1, UCase(arrInfo(1))))
Sheets("Sheet3").Cells(1, Asc(UCase(arrInfo(2))) + j - 64) _
.Resize(rowsize:=arrInfo(0)) = arrOut
j = j + 1
Next
End With
End Sub

Enter the informations comma separated but without space


Regards
Claus B.

 

[Claus Busch]

Hi Howard,

Am Sat, 24 May 2014 15:37:49 +0200 schrieb Claus Busch:

change the following lines:

Info = Application.InputBox("Enter the number of rows," _
& "the source column and the target column comma separated",
"Infos", _
Type:=2)

Info = Application.InputBox("Enter the number of rows," _
& "the source column and the target column comma separated", _
"Infos", Type:=2)

If Info = "" Or Info = "False" Then Exit Sub


Regards
Claus B.

 

[L. Howard]

Hi Howard,



Am Sat, 24 May 2014 15:37:49 +0200 schrieb Claus Busch:



change the following lines:







Info = Application.InputBox("Enter the number of rows," _

& "the source column and the target column comma separated", _

"Infos", Type:=2)



If Info = "" Or Info = "False" Then Exit Sub





Regards

Claus B.

--

A work of art in my eyes!!

Works perfect.

Thanks,
Howard

 

[Claus Busch]

Hi Howard,

Am Sat, 24 May 2014 07:48:19 -0700 (PDT) schrieb L. Howard:

Works perfect.

I changed the code that it also works in columns with two or three
letters. The first code only works until column Z:

Sub TransformCol()
Dim Info As String
Dim LRow As Long, i As Long, j As Long
Dim arrOut As Variant
Dim arrInfo As Variant
Dim StartCol As Long

Info = Application.InputBox("Enter the number of rows," _
& "the source column and the target column comma separated", _
"Infos", Type:=2)

If Info = "" Or Info = "False" Then Exit Sub

arrInfo = Split(Info, ",")
StartCol = Columns(arrInfo(2)).Column

With Sheets("Sheet2")
LRow = .Cells(Rows.Count, arrInfo(1)).End(xlUp).Row
For i = 1 To LRow Step arrInfo(0)
arrOut = .Range(.Cells(i, UCase(arrInfo(1))), _
.Cells(i + arrInfo(0) - 1, UCase(arrInfo(1))))
Sheets("Sheet3").Cells(1, StartCol + j) _
.Resize(rowsize:=arrInfo(0)) = arrOut
j = j + 1
Next
End With
End Sub


Regards
Claus B.

 

[Claus Busch]

Hi again,

Am Sat, 24 May 2014 16:59:31 +0200 schrieb Claus Busch:

the code below is for universal use:

Sub TransformCol()
Dim Info As String
Dim LRow As Long, i As Long, j As Long
Dim arrOut As Variant
Dim arrInfo As Variant
Dim SourceCol As Long, TargetCol As Long

Info = Application.InputBox("Enter the number of rows," _
& "the source column and the target column comma separated", _
"Infos", Type:=2)

If Info = "" Or Info = "False" Then Exit Sub

arrInfo = Split(Info, ",")

SourceCol = Columns(UCase(arrInfo(1))).Column
TargetCol = Columns(UCase(arrInfo(2))).Column

With Sheets("Sheet2")
LRow = .Cells(Rows.Count, SourceCol).End(xlUp).Row
For i = 1 To LRow Step arrInfo(0)
arrOut = .Range(.Cells(i, SourceCol), _
.Cells(i + arrInfo(0) - 1, SourceCol))
Sheets("Sheet3").Cells(1, TargetCol + j) _
.Resize(rowsize:=arrInfo(0)) = arrOut
j = j + 1
Next
End With
End Sub


Regards
Claus B.

 

[Claus Busch]

Hi Howard,

Am Sat, 24 May 2014 17:24:19 +0200 schrieb Claus Busch:

the code below is for universal use:

and with error handling if wrong source or target column is chosen:

Sub TransformCol()
Dim Info As String
Dim LRow As Long, i As Long, j As Long
Dim arrOut As Variant
Dim arrInfo As Variant
Dim SourceCol As Long, TargetCol As Long

Start:
Info = Application.InputBox("Enter the number of rows," _
& "the source column and the target column comma separated", _
"Infos", Type:=2)

If Info = "" Or Info = "False" Then Exit Sub

arrInfo = Split(Info, ",")

SourceCol = Columns(UCase(arrInfo(1))).Column
TargetCol = Columns(UCase(arrInfo(2))).Column

With Sheets("Sheet2")
LRow = .Cells(Rows.Count, SourceCol).End(xlUp).Row

If LRow < arrInfo(0) Or LRow = 1 Then
MsgBox "Wrong source column"
GoTo Start
End If

If TargetCol + Int(LRow / arrInfo(0)) + 1 > 16384 Then
MsgBox "Not enough columns available"
GoTo Start
End If

For i = 1 To LRow Step arrInfo(0)
arrOut = .Range(.Cells(i, SourceCol), _
.Cells(i + arrInfo(0) - 1, SourceCol))
Sheets("Sheet3").Cells(1, TargetCol + j) _
.Resize(rowsize:=arrInfo(0)) = arrOut
j = j + 1
Next
End With
End Sub


Regards
Claus B.

 

[L. Howard]

Great stuff indeed.

I assume this converts the column letter/s to a column number and also convers lower case entries to upper case so they will work with the code?

SourceCol = Columns(UCase(arrInfo(1))).Column
TargetCol = Columns(UCase(arrInfo(2))).Column

Thank again.

Howard