VBA: Optimise Code?

[AD_Taylor]

Hi guys,

The code below works, however I'm pretty sure it can be shortened, written better and generally made more useful.

It should first look for whether the selected area is bigger than 1 cell. If the selection is bigger it will work with the selection, if not prompt the user to see if they want it to run on the whole 'UsedRange' of the sheet.
If they say no to this it will not do anything.

Then another prompt to see if they want to inlcude blank values in the output or not which currently sets a Boolean variable.

Finally the code should run through each column separately (left to right) and each row in that column (top to bottom) in the range that was chosen and output the cells in that order to a separate sheet called OutputData.
The data should be ouput into Column A of that sheet.

I've used an array to hopefully make things easier: Store data to the array and then loop through the array to output it later.

Thanks for any advice with this,
Adam

PS: As a side note, I'd like to have the settings come up as a UserForm with 3 parts:

Drop down box for range to use: current selection, entire worksheet
Inlcude blanks: As a checkbox to be turned on or off
Output Destination: Select either a pre existing sheet or a new sheet (new sheet called OutputData)
Output Column: Allow the user to select the column of the sheet where they want the data to go.

But I know close to nothing about UserForms so I went with the easy way

Heres the code:

Sub MoveSelectToCol()

Dim strToOutput() As String
Dim inputRng As Range
Dim wsOutput As Worksheet, checkSht As Worksheet
Set inputRng = Selection

Dim inlcudeBlanks As Boolean

Dim checkRng As Range
Dim currCol As Range
Dim currRow As Integer
Dim numOfItems As Integer

Dim x1 As Long, x2 As Long, x3 As Long
x1 = 0
x2 = 0
x3 = 0

If inputRng.Rows.Count = 1 And inputRng.Columns.Count = 1 Then

    mmsgbox1 = MsgBox("Do you want to move the whole sheet to 1 column?", vbYesNo, "Microsoft Excel")
    
    If mmsgbox1 = vbYes Then
    
        Set checkRng = ActiveSheet.UsedRange
        
    ElseIf mmsgbox1 = vbNo Then
    
        mmsgbox2 = MsgBox("Please make a bigger selection.", vbOKOnly, "Microsoft Excel")
        Exit Sub
        
    End If

Else

    Set checkRng = inputRng
    
End If

mmsgbox3 = MsgBox("Would you like to include, and therefore output, blank cells as well?", vbYesNo, "Microsoft Excel")

If mmsgbox3 = vbYes Then

    includeBlanks = True
    
ElseIf mmsgbox3 = vbNo Then

    includeBlanks = False

End If

numOfItems = checkRng.Cells.Count

ReDim strToOutput(1 To numOfItems)

x2 = 1

For x1 = 1 To checkRng.Columns.Count

    Set currCol = checkRng.Columns(x1)
    
    For currRow = currCol.Row To (currCol.Row + currCol.Rows.Count - 1)
    
        If includeBlanks = True Then
    
            strToOutput(x2) = Cells(currRow, currCol.Column)
            x2 = x2 + 1
        
        ElseIf includeBlanks = False Then
        
            If Cells(currRow, currCol.Column) <> "" Then
            
                strToOutput(x2) = Cells(currRow, currCol.Column)
                x2 = x2 + 1
            
            End If
            
        End If
    
    Next currRow

Next x1

On Error Resume Next

Set checkSht = Sheets("OutputData")

On Error GoTo 0

If Not checkSht Is Nothing Then

    checkSht.UsedRange.Clear
    checkSht.Activate
    
Else

    Set wsOutput = Sheets.Add(After:=Worksheets(Worksheets.Count))
    wsOutput.Name = "OutputData"
    wsOutput.Activate
    
End If

For x3 = LBound(strToOutput) To UBound(strToOutput)

    Cells(x3, 1).Value = strToOutput(x3)

Next x3

End Sub