VBA Excel - Putting columns into range in right order

Question

so recently I have been looking into using defined ranges to copy data instead of selecting, copying and pasting cells. This way I hope to optimise the performance and the runtime of my code.

Unfortunately I have come to face a problem I wasn't able to solve on my own.

When defining a range I want to rearrange the columns in a different order.

For example:

Set my_range = Sheets("Sheet1").Range("A2:E2,G2:H2,J2:K2,M2")

Works well, as the columns I fill into the range are behind each other in the sheet. But now I have this:

Set yo_range = Sheets("Sheet2").Range("D2,AV2,L2,H2,Q2,AE2,AG2")

If I fill these ranges into a new sheet the yo_range will fill the columns I put into it but not in the order I written down. It will put it down in the order according to the original one. In this example yo_range would put the data in this order into the new sheet:

D2 | H2 | L2 | Q2 | AE2 | AG2 | AV2

How can I fix this? I want the order to be another one than the original one. Also - as you can see my_range has more columns than yo_range. How can I let yo_range be filled into the new sheet but at certain points leave columns out? For example:

my_range(A2:E2) goes into A2:E2 in the new sheet

yo_range(D2,AV2) goes into A:B in the new sheet, then leave C out and then paste yo_range(L2,H2) into D:E in the new sheet

I hope that I was able to explain my problem well and that there is somebody able and willing to help me. Any help is appreciated.

Edit:

Here's the code that puts the values from the ranges into the new sheet

Do
    If Application.WorksheetFunction.CountA(my_range) > 0 Then
    my_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
    Set my_range = my_range.Offset(1, 0)
    Else
    Exit Do
    End If
Loop


Do
    If Application.WorksheetFunction.CountA(yo_range) > 0 Then
    yo_range.Copy ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
    Set yo_range = yo_range.Offset(1, 0)
    Else
    Exit Do
    End If
Loop

Perhaps instead of defining one single range and having excel neaten that arrangement for you, you could build an array of ranges (or perhaps of each cells .value) and loop through that array (or transpose the array into a sheet) to get your desired output? — Glitch_Doctor
– Glitch_Doctor, Commented Dec 8, 2017 at 10:48
Which exact code are you using to copy the range? I've found that different results can occur, depending on whether you use .copy(dest), .copy() and .pasteSpecial, ... Also, different results can occur depending on how much cells are in your dest ... So please post the exact code you are using ... — Peter Pesch
– Peter Pesch, Commented Dec 8, 2017 at 11:04
As Glitch_Doctor mentioned, I think its probably best to save your named ranges into either arrays or set a separate range for each of the columns you want to paste in different columns... — Xabier
– Xabier, Commented Dec 8, 2017 at 11:07

Robin Mackenzie · Accepted Answer · 2017-12-08 12:30:34Z

We can see that the Copy method will re-arrange the data left-to-right. Try this:

Option Explicit

Public Sub CheckClipboard()

    Dim ws As Worksheet
    Dim rngToCopy As Range
    Dim objData As Object
    Dim varContents As Variant

    ' test data b,c,d,e,f,g in Sheet1!B1:G1
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Range("B1:G1").Value = Array("b", "c", "d", "e", "f", "g")

    Set rngToCopy = ws.Range("E1:F1,G1,B1:C1") '<-- note not left-to-right order
    rngToCopy.Copy '<-- copy

    ' this is a late bound MSForms.DataObject
    Set objData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    ' copy current cell formula to clipboard
    objData.GetFromClipboard
    varContents = objData.GetText

    Debug.Print varContents '<-- re-arranged left-to-right

    ' cancel copy
    Application.CutCopyMode = False

End Sub

I get this in the immediate window:

b   c   d   e   f   g

So, using Copy is not going to work for what you want to do.

In order to 'paste' the data in the order that you set it in the Range, you need to iterate each Area of the Range and then each cell (i.e. Range) in each Area. See the test code below which replicates your issue and presents a solution:

Option Explicit

Sub MixColumns()

    Dim ws As Worksheet
    Dim rngIn As Range
    Dim rngOut As Range
    Dim lng As Long
    Dim rngArea As Range
    Dim rngCell As Range

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    ' example 1
    Set rngIn = ws.Range("B1:C1,E1:F1,G1") '<-- 5 cells, non-contiguous, forward order
    Set rngOut = ws.Range("B2:F2") '<-- 5 contiguous cells

    rngIn.Copy rngOut '<-- works


    ' example 2 - OP problem
    Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
    Set rngOut = ws.Range("B3:F3") '<-- 5 contiguous cells

    rngIn.Copy rngOut '<-- should be e,f,g,b,c but gets b,c,e,f,g


    ' example 3 - solution for OP problem
    Set rngIn = ws.Range("E1:F1,G1,B1:C1") '<-- 5 cells, non-contiguous, odd order
    Set rngOut = ws.Range("B4:F4") '<-- 5 contiguous cells

    lng = 1 '<-- rngOut cell counter
    ' iterate areas
    For Each rngArea In rngIn.Areas
        ' iterate cells in area
        For Each rngCell In rngArea.Cells
            rngOut.Cells(1, lng).Value = rngCell.Value '<-- copy single value
            lng = lng + 1 '<-- increment rngOut counter
        Next rngCell
    Next rngArea '<-- results in e,f,g,b,c


End Sub

Give this output:

Collectives™ on Stack Overflow

VBA Excel - Putting columns into range in right order

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related