Input for range

Question

Not quite sure what is wrong with my code but it is not printing in one straight column. It works when you say

cells(i,j).copy
range(i,j).pastespecial

But throws out values in cells which are completely random when you request a range of values, like

set rng=Application.inputbox(" Please select range", Type=:8)

Everything works except when you request the user to select a range.

Sub select1()

Dim rng As Variant
Dim i, j, k As Integer

Set rng = Application.InputBox("please select range", Type:=8)

With ActiveSheet
  i = 1
  k = 1
  For j = 1 To rng.Columns.Count
     For i = 1 To rng.Rows.Count
       rng(Cells(i, j)).Copy
       Range("l" & k).PasteSpecial
       k = k + 1
     Next i
     i = 1
 Next j
End With

End Sub

So for this table

jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda

I must get( in 1 column)

jenny
jenny
jenny
jenny
jenny
doon
doon
doon
doon
doon
felix
felix
felix
felix
felix
spi
spi
spi
spi
spi
gav
gav
gav
gav
gav
benj
benj
benj
benj
benj

Answer 1

This

rng(Cells(i, j)).Copy
Range("L" & k).PasteSpecial

should be

rng.Cells(i, j).Copy
.Range("L" & k).PasteSpecial

or

rng.Cells(i, j).Copy Destination:=.Range("L" & k)

---

Or if you only want to copy the value then this would be even better:

.Range("L" & k).Value = rng.Cells(i, j).Value

---

In total I recommend the following

• Introduce some error handling for your Application.InputBox otherwise it fails if the uses presses the Cancel button.

• Test if multiple areas are selected (we don't know how to handle them, so we need to disallow them).

• Use arrays: Read the source range into an array SrcArr = SrcRng.Value and use an array for output ReDim DestArr(1 To SrcRng.Cells.Count, 1 To 1) As Variant. This way you only have one cell read/write action which makes your code much faster. The transformation is completely performed within the arrays.

So you end up with …

Option Explicit

Public Sub TransformRange()
    Dim SrcRng As Range
    On Error Resume Next 'next line throws error if user presses cancel so hide all errors
    Set SrcRng = Application.InputBox("please select range", Type:=8)
    On Error GoTo 0 'don't forget to re-activate error reporting

    If SrcRng Is Nothing Then Exit Sub

    If SrcRng.Areas.Count > 1 Then
        MsgBox "More than one area was selected I'm not sure what to do"
        Exit Sub
    End If

    'read everything into an array
    Dim SrcArr() As Variant
    SrcArr = SrcRng.Value

    'transform values
    ReDim DestArr(1 To SrcRng.Cells.Count, 1 To 1) As Variant
    Dim iRow As Long, iCol As Long, iArr As Long
    iArr = 1 'initialize

    For iCol = 1 To UBound(SrcArr, 2)
        For iRow = 1 To UBound(SrcArr, 1)
            DestArr(iArr, 1) = SrcArr(iRow, iCol)
            iArr = iArr + 1
        Next iRow
    Next iCol

    'write values into sheet
    SrcRng.Parent.Range("L1").Resize(RowSize:=UBound(DestArr, 1)).Value = DestArr
    'SrcRng.Parent <-- this represents the sheet of the selected range
End Sub

Answer 2

This is another array based approach which may be useful in your other general applications. This routine can transfer data to sheet2. However I have commented out use of 2nd sheet and have used Active Sheet only. You can change references as per your requirement. It is working correctly for me and the relevant file is available for your reference on dropbox.

   Sub FillWS3()
    Dim i As Long, j As Long, currentRow As Long
    Dim lastRow As Long
    Dim lastCol As Long
    Dim rng As Range
    Dim period As Variant
    Dim trperiod As Variant
    Dim ws1 As Worksheet, ws2 As Worksheet
    ' Set references to worksheets
    Set ws1 = ThisWorkbook.Worksheets("Worksheet1")
    Set ws2 = ThisWorkbook.Worksheets("Worksheet2")
      ' Determine last row in column A in worksheet1
    lastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
      ' Determine last column in column A in worksheet1
    lastCol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    currentRow = 1
    i = 1

    Set rng = Application.InputBox("please select range", Type:=8)
    period = rng.Value
    'period = ws1.Range(Cells(1, 1), Cells(lastRow, lastCol)).Value
    trperiod = Application.Transpose(period)

    For i = LBound(trperiod, 1) To UBound(trperiod, 1)
        For j = LBound(trperiod, 2) To UBound(trperiod, 2)
            ws1.Cells(currentRow, 12).Value = trperiod(i, j)
            currentRow = currentRow + 1
        Next j
    Next i
End Sub

Results Obtained

EDIT: As per @PEH good suggestion I have removed Transpose method and modified array loop. Edited Code as follows.

   Sub FillWS3()
    Dim i As Long, j As Long, currentRow As Long
    Dim lastRow As Long
    Dim lastCol As Long
    Dim rng As Range
    Dim period As Variant
    Dim trperiod As Variant
    Dim ws1 As Worksheet, ws2 As Worksheet
    ' Set references to worksheets
    Set ws1 = ThisWorkbook.Worksheets("Worksheet1")
    Set ws2 = ThisWorkbook.Worksheets("Worksheet2")
      ' Determine last row in column A in worksheet1
    lastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
      ' Determine last column in column A in worksheet1
    lastCol = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    currentRow = 1
    i = 1

    Set rng = Application.InputBox("please select range", Type:=8)
    period = rng.Value
    'period = ws1.Range(Cells(1, 1), Cells(lastRow, lastCol)).Value
    'trperiod = Application.Transpose(period)

    For j = LBound(period, 2) To UBound(period, 2)
        For i = LBound(period, 1) To UBound(period, 1)
            ws1.Cells(currentRow, 12).Value = period(i, j)
            currentRow = currentRow + 1
        Next i
    Next j
End Sub