VBA Dynamically select a single column reference on a static set of multiple rows?-CodePudding

I am working on creating a report for someone in my organization. The report has multiple scenarios that they want to test by copying a single scenario and pasting it into a column that then will do a calculation. The parts they copy are not in a constant order, ie it is multiple selections (E30:E34 , E37:E39 , etc.) But they are all in the same column (E for instance) and the row number reference on the multiple selections will always be the same for each scenario. I only need to change the column reference from E all the way to AW (possibly more in the future). I was thinking maybe there is way to set up a cell above each scenario to use as a "check box" that the vba code could look for to know to use that column reference. Or possibly just an entry box to type the column letter they want. I have a loop code written and working to run through the multiple selections and copy paste I will post below. I just need a way to dynamically change the column reference in the rArray (E to F or G or H etc.) I hope this is possible. Thanks!

This is the code I have to copy and paste the selected ranges:

Sub CopyScenario()

    Dim rArray(1 To 22) As Range
    Dim tArray(1 To 22) As Range

'Set up ranges for selected scenario

    Set rArray(1) = Sheets("LMA").Range("E30:E34")
    Set rArray(2) = Sheets("LMA").Range("E37:E39")
    Set rArray(3) = Sheets("LMA").Range("E41")
    Set rArray(4) = Sheets("LMA").Range("E43:E44")
    Set rArray(5) = Sheets("LMA").Range("E47:E50")
    Set rArray(6) = Sheets("LMA").Range("E52")
    Set rArray(7) = Sheets("LMA").Range("E54")
    Set rArray(8) = Sheets("LMA").Range("E56:E57")
    Set rArray(9) = Sheets("LMA").Range("E59:E60")
    Set rArray(10) = Sheets("LMA").Range("E64:E66")
    Set rArray(11) = Sheets("LMA").Range("E69:E70")
    Set rArray(12) = Sheets("LMA").Range("E72")
    Set rArray(13) = Sheets("LMA").Range("E83:E87")
    Set rArray(14) = Sheets("LMA").Range("E89:E91")
    Set rArray(15) = Sheets("LMA").Range("E93:E95")
    Set rArray(16) = Sheets("LMA").Range("E99:E100")
    Set rArray(17) = Sheets("LMA").Range("E102:E103")
    Set rArray(18) = Sheets("LMA").Range("E106")
    Set rArray(19) = Sheets("LMA").Range("E111:E118")
    Set rArray(20) = Sheets("LMA").Range("E123:E124")
    Set rArray(21) = Sheets("LMA").Range("E126:E130")
    Set rArray(22) = Sheets("LMA").Range("E133:E135")
    
'Set ranges for calc info to be pasted in

    Set tArray(1) = Sheets("LMA").Range("C30")
    Set tArray(2) = Sheets("LMA").Range("C37")
    Set tArray(3) = Sheets("LMA").Range("C41")
    Set tArray(4) = Sheets("LMA").Range("C43")
    Set tArray(5) = Sheets("LMA").Range("C47")
    Set tArray(6) = Sheets("LMA").Range("C52")
    Set tArray(7) = Sheets("LMA").Range("C54")
    Set tArray(8) = Sheets("LMA").Range("C56")
    Set tArray(9) = Sheets("LMA").Range("C59")
    Set tArray(10) = Sheets("LMA").Range("C64")
    Set tArray(11) = Sheets("LMA").Range("C69")
    Set tArray(12) = Sheets("LMA").Range("C72")
    Set tArray(13) = Sheets("LMA").Range("C83")
    Set tArray(14) = Sheets("LMA").Range("C89")
    Set tArray(15) = Sheets("LMA").Range("C93")
    Set tArray(16) = Sheets("LMA").Range("C99")
    Set tArray(17) = Sheets("LMA").Range("C102")
    Set tArray(18) = Sheets("LMA").Range("C106")
    Set tArray(19) = Sheets("LMA").Range("C111")
    Set tArray(20) = Sheets("LMA").Range("C123")
    Set tArray(21) = Sheets("LMA").Range("C126")
    Set tArray(22) = Sheets("LMA").Range("C133")
    
'Copy paste loop thru ranges
    
    Dim i, j As Integer
    
    For i = 1 To 22
    rArray(i).Copy
    j = 0
        Do Until Sheets("LMA").Cells(21   j, 21).Value = ""
            j = j   1
        Loop
    tArray(i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Next
    


End Sub

CodePudding user response：

Try another range syntax:

Dim columnRef as Long:  columnRef = 5
'Dim columnRef as String:  columnRef = "E"
'Dim columnRef as Long:  columnRef = Selection.Column
With Sheets("LMA")
    .Range( .Cells( 1, columnRef), .Cells( 2, columnRef))
End With

You can use columnRef as a reference for your specific column.

As for pulling the Selection.Column, you have a lot of ways to do that, where you will have to give your specific example. Each will have different associated code.

CodePudding user response：

Copy Single-Column Areas

Note that this is my choice which requires referencing the worksheet.
If the code will always be in the workbook containing the worksheet, only a few lines need to be rearranged (modified) to call it e.g. with CopyColumns "LMA", 5, 3, or if it is worksheet-specific, with a simple CopyColumns 5, 3. Have a think and let me know.

Utilization

Sub CopyColumnsTEST()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets("LMA")
    
    CopyColumns ws, "E", "C"
    'or equivalently:
    'CopyColumns ws, 5, 3
    
End Sub

The Method

Sub CopyColumns( _
         ByVal ws As Worksheet, _
         ByVal SourceColumn As Variant, _
         ByVal DestinationColumn As Variant)
         
    Dim RowsAddress As String: RowsAddress _
        = "30:34,37:39,41:41,43:44,47:50,52:52," _
        & "54:54,56:57,59:60,64:66,69:70,72:72," _
        & "83:87,89:91,93:95,99:100,102:103,106:106," _
        & "111:118,123:124,126:130,133:135"
        
    Dim rrg As Range: Set rrg = ws.Range(RowsAddress)
    Dim srg As Range: Set srg = Intersect(rrg, ws.Columns(SourceColumn))
    Dim drg As Range: Set drg = Intersect(rrg, ws.Columns(DestinationColumn))
    
    Dim n As Long
    
    For n = 1 To srg.Areas.Count
        drg.Areas(n).Value = srg.Areas(n).Value
    Next n

End Sub