User Input to set last column in range to copy

Hi All,

If possible could someone please help with changing the below code so that column "D" in the rngIn part of the code can be a variable. i.e so the user can select one, two, three or four columns (with visible data) to be copied. The "b3" part is a constant.

All help is appreciated.

Sub x() 'Moves Visible Range to sheet and formats
  Application.ScreenUpdating = False
Sheets("Edit").Activate
    Dim rngIn As Range
    Dim rngOut As Range
    Dim rngX As Range
    Dim answr As VbMsgBoxResult

'answr = MsgBox("Tool", vbYesNo + vbQuestion, "Copy")
'If answr = vbNo Then End


'End With

Set rngIn = Sheets("Edit").Range("b3:d" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
    For Each rngX In rngIn.Rows
        Set rngOut = Sheet24.Range("A" & Rows.Count).End(xlUp)

Cheers

what is this actually doing?

Maybe something like

  Application.ScreenUpdating = False
    Dim Col    As Long
    Dim rngIn  As Range
    Dim rngOut As Range
    Dim rngX   As Range
    Dim answr  As VbMsgBoxResult
    With Sheets("Edit")
        'answr = MsgBox("Tool", vbYesNo + vbQuestion, "Copy")
        'If answr = vbNo Then End


        'End With
        Col = Application.InputBox("Enter final column of data to copy", Type:=1)
        If Col < 2 Or Col > 4 Then Exit Sub    'change max & min column here
        Set rngIn = .Range(.Cells(3, 2), Cells(.Rows.Count, Col).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
    End With

The c ode asks for the user to input a column, in the example between B & D. You can change this as necessary

Have you go a sheet clled Edit/

Attach the workbook that errors

Sorry but you need to not only revise the code, bu look at the design of the spreadsheet itself


There are several errors in the code itself for e.g. you turn off screenupdating at the end of he code, this will have the effect of preventing the sheet refreshing & you will not see he sheet; yo seem to want to loop hrough cells, but use Rows instead of a range

 For Each rngX In rngIn.Rows

Why are you using a ToggleButton instead of a Commandbutton? The code in this button again uses Row, but you don't need it

I've tried to amend the code to do what I think you wan.

Thanks Roy,

The code almost does exactly what I want it too.

The only issue is that it is copying the rows based on the last selected column when it should copy all visible rows in column B and include or exclude information based on the user input.

Cheers

Is this what you mean/

Private Sub CommandButton1_Click()
 Dim rngIn  As Range
    Dim rngOut As Range
    Dim rngCl  As Range
    Dim Col    As Long
    Dim Rw     As Long
    Dim LastRw As Long
    Dim answr  As VbMsgBoxResult

    With Sheet19
        Col = Application.InputBox("Enter final column of data to copy", Type:=1)
        If Col < 3 Or Col > 5 Then Exit Sub    'change max & min column here
        LastRw = .Cells(.Rows.Count, 2).End(xlUp).Row
        Set rngIn = .Range(.Cells(3, 2), .Cells(LastRw, Col))    '.SpecialCells(xlCellTypeVisible)
    End With

    With Sheet24
        .Cells.Clear
        Rw = 1
        For Each rngCl In rngIn
            If Not IsEmpty(rngCl) Then
                .Cells(Rw, 1).Value = rngCl.Value
                Rw = Rw + 1
            End If
        Next rngCl

        Application.CutCopyMode = False
        With .UsedRange
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    End With
    'Call OtherBlaBla
    Application.Goto Sheet24.Cells(1, 1)
End Sub

I've corrected that

Private Sub CommandButton1_Click()
 Dim rngIn  As Range
    Dim rngOut As Range
    Dim rngCl  As Range
    Dim Col    As Long
    Dim Rw     As Long
    Dim LastRw As Long
    Dim answr  As VbMsgBoxResult

    With Sheet19
        Col = Application.InputBox("Enter final column of data to copy", Type:=1)
        If Col < 3 Or Col > 5 Then Exit Sub    'change max & min column here
        LastRw = .Cells(.Rows.Count, 2).End(xlUp).Row
        Set rngIn = .Range(.Cells(3, 2), .Cells(LastRw, Col)).SpecialCells(xlCellTypeVisible)
    End With

    With Sheet24
        .Cells.Clear
        Rw = 1
        For Each rngCl In rngIn
            If Not IsEmpty(rngCl) Then
                .Cells(Rw, 1).Value = rngCl.Value
                Rw = Rw + 1
            End If
        Next rngCl

        Application.CutCopyMode = False
        With .UsedRange
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    End With
    'Call OtherBlaBla
    Application.Goto Sheet24.Cells(1, 1)
End Sub