Combine three InputBoxes into one?
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 |
Combine three InputBoxes into one?
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. -- Vista Ultimate / Windows7 Office 2007 Ultimate / 2010 Professional |
Combine three InputBoxes into one?
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. -- Vista Ultimate / Windows7 Office 2007 Ultimate / 2010 Professional |
Combine three InputBoxes into one?
On Saturday, May 24, 2014 6:44:46 AM UTC-7, Claus Busch wrote:
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. -- A work of art in my eyes!! Works perfect. Thanks, Howard |
Combine three InputBoxes into one?
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. -- Vista Ultimate / Windows7 Office 2007 Ultimate / 2010 Professional |
Combine three InputBoxes into one?
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. -- Vista Ultimate / Windows7 Office 2007 Ultimate / 2010 Professional |
Combine three InputBoxes into one?
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. -- Vista Ultimate / Windows7 Office 2007 Ultimate / 2010 Professional |
Combine three InputBoxes into one?
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 |
All times are GMT +1. The time now is 10:38 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com