Vba macro how to move columns

[gibsongk55]

Hi,

I have many spreadsheets that I need to check over and then rearrange the order of the columns while keeping the rows in the same order.

Is there a way I can do a vba macro to do this?

Here is what i need to do:

Move columns:
Q to A
R to B
B to C
H to D
G to E
I to F
J to G
K to H
L to I
M to J
O to K
N to L
C to M
F to N
P to O
E to P
D to Q

and then Delete column S

Thanks for any help,

Gibs

 

[Misca]

The rest of the columns were out of order because the column order had already been changed (= when Q becomes A the old A becomes B etc.). The R-column (= column 18) stayed where it was because the first move only changed the orders of the first 17 columns.

The following code sets the columns to ranges before changes and should be able to put them in the correct order:

Sub ReArrangeColumns()
Dim i As Integer
Dim RNG(16) As Range
Application.ScreenUpdating = False
With ActiveSheet
    For i = 1 To 17
        Set RNG(i - 1) = .Columns(Choose(i, 17, 18, 2, 8, 7, 9, 10, 11, 12, 13, 15, 14, 3, 6, 16, 5, 4))
    Next i
    
    For i = 0 To 16
        RNG(i).Cut
        .Range("A1").Offset(0, i).Insert shift:=xlToRight
    Next i
        .Columns(19).Delete 'Deletes column S
End With
End Sub

 

[mirabeau]

Okay I fixed that and ran it on a spreadsheet with 1,000 records. Took almost 2 minutes then gave me this error below.

run-time error' 1004:

Application-defined or object-defined error.

Highlighting this: ".Columns(a(i, 1)).Copy .Cells(1, a(i, 2) + 128)"

Thanks,

Gibs

As it stands that code only deals with up to 50 columns.

It's very easily extended to more, up to the limits of your worksheet, but I couldn't predict how many you might to move, nor how many columns are on your worksheet, Excel 2003 with only 256, or 2007 et seq with 16384.

I suppose by "records" you mean number of columns to move.

 

[mirabeau]

hey gibsongk55,

on reflection, you might find this one more to your liking.

have whatever data size you like and it shouldn't take long

data layout the same as in my earlier post

Sub reordercolumns()
Dim a, n As Long, i As Long
Dim lr As Long, lc As Long

With Sheets("sheet2")
    n = .Range("B1").End(4).Row
    a = .Range("A1:B" & n)
End With

With Sheets("sheet1").Cells
    lr = .Find("*", after:=Cells(1), _
        searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    lc = .Find("*", after:=Cells(1), _
        searchorder:=xlByColumns, searchdirection:=xlPrevious).Column

    For i = 1 To n
        Cells(lr + 1, "" & a(i, 1) & "") = a(i, 2)
    Next i
    .Resize(lr + 1, lc).Sort .Rows(lr + 1), 1, Orientation:=xlLeftToRight
    .Cells(lr + 1, 1).Resize(, n).ClearContents
    .Cells(1, "s").Resize(lr).Delete
End With
End Sub

 

[gibsongk55]

hey gibsongk55,

on reflection, you might find this one more to your liking.

have whatever data size you like and it shouldn't take long

data layout the same as in my earlier post

Sub reordercolumns()
Dim a, n As Long, i As Long
Dim lr As Long, lc As Long

With Sheets("sheet2")
    n = .Range("B1").End(4).Row
    a = .Range("A1:B" & n)
End With

With Sheets("sheet1").Cells
    lr = .Find("*", after:=Cells(1), _
        searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    lc = .Find("*", after:=Cells(1), _
        searchorder:=xlByColumns, searchdirection:=xlPrevious).Column

    For i = 1 To n
        Cells(lr + 1, "" & a(i, 1) & "") = a(i, 2)
    Next i
    .Resize(lr + 1, lc).Sort .Rows(lr + 1), 1, Orientation:=xlLeftToRight
    .Cells(lr + 1, 1).Resize(, n).ClearContents
    .Cells(1, "s").Resize(lr).Delete
End With
End Sub

Thanks so much, that worked perfectly.


Gibs

 

[Rick Rothstein]

Are your values in Columns A:R all constants (that is, there are no formulas in those columns)? If so, then here is a very fast non-looping macro for you to consider...

Sub MoveColumnsAround()
  Dim NewColumnNumberOrder As String, LastRow As Long, Cols As Variant
  ' Column Letter Order:  Q  R  B H G I J  K  L  M  O  N  C F P  E D
  NewColumnNumberOrder = "17 18 2 8 7 9 10 11 12 13 15 14 3 6 16 5 4"
  LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  Cols = Application.Index(Cells, Evaluate("Row(1:" & LastRow & ")"), Split(NewColumnNumberOrder))
  Application.ScreenUpdating = False
  Columns("A:S").Clear
  Range("A1").Resize(LastRow, UBound(Split(NewColumnNumberOrder)) + 1) = Cols
  Application.ScreenUpdating = True
End Sub

 

[mirabeau]

If so, then here is a very fast non-looping macro for you to consider...

Hmm...

Seems a claim that's much easier to make than it is to substantiate.

This alleged "very fast" code seems actually rather slow compared with the code quoted in the preceding post#14. It gets relatively much slower as the column length inceases, and with long enough columns it won't even run at all.

When run, then re-run, mysterious gaps start to appear in the data. Do these have some useful purpose?

This putative "very fast" "non-looping" macro also somehow supposes that the originally-requested letter descriptions for the columns are already converted (by zero-time, non-looping, unexplained methods?) into numbers which are then directly incorporated into the code. This technique easily allows the already-faster code quoted in Post#14 to be trivially made even faster, and non-looping as well if that's considered an advantage.

 

[Rick Rothstein]

This alleged "very fast" code seems actually rather slow compared with the code quoted in the preceding post#14. It gets relatively much slower as the column length inceases, and with long enough columns it won't even run at all.

When run, then re-run, mysterious gaps start to appear in the data. Do these have some useful purpose?

This putative "very fast" "non-looping" macro also somehow supposes that the originally-requested letter descriptions for the columns are already converted (by zero-time, non-looping, unexplained methods?) into numbers which are then directly incorporated into the code. This technique easily allows the already-faster code quoted in Post#14 to be trivially made even faster, and non-looping as well if that's considered an advantage.

I tried to run the code in Post #14, but kept getting a 1004 run-time error as soon as it hit the For loop's active line of code, so I don't know how fast that code is. I didn't try to debug it, but is it expecting a certain type of data in a specific location? I used A1 copied down in Column A, B1 copied down in Column B and so on for my data.

I tested my code against a 20,000 row set of data and it moved the columns in just under 7.5 seconds. That seemed kind of fast to me, hence my claim. If I could get the code you referred to working, I'd be happy to test it on my computer for a comparison using the same hardware for both tests. I did not see an gaps (mysterious or otherwise) when I reran the code.

 

[mirabeau]

I tried to run the code in Post #14, but kept getting a 1004 run-time error as soon as it hit the For loop's active line of code, so I don't know how fast that code is. I didn't try to debug it, but is it expecting a certain type of data in a specific location? I used A1 copied down in Column A, B1 copied down in Column B and so on for my data.

I tested my code against a 20,000 row set of data and it moved the columns in just under 7.5 seconds. That seemed kind of fast to me, hence my claim. If I could get the code you referred to working, I'd be happy to test it on my computer for a comparison using the same hardware for both tests. I did not see an gaps (mysterious or otherwise) when I reran the code.

Regarding data location, the requirements of the thread were specified in Post#1 (columnQ to ColumnA etc), and the way I approached this was to list OP's origins and destinations (in letters, as specified in Post#1) in the first two columns of Sheet2.
This was explained in some detail in Post#4, to ensure there wouldn't be 1004 or similar errors.
OP seemed to have no trouble running the code in Post#13. I tested it before posting to check for possible errors. I'm surprised that you got errors.

I generated 20,000 row data generated with the following testdata code.

Sub testdata()
Sheets("sheet1").Activate
ActiveSheet.UsedRange.ClearContents
Dim n, m
n = 20000: m = 19
With [a1].Resize(n, m)
    .Cells = "= int(rand()*20)+1"
    .Resize(1) = "=char(column()+64)"
    .Value = .Value
End With
End Sub

It seems to me that your 7.5 secs is very slow to re-order these data, and in fact running your code took 0.38 secs on an i7 processor laptop with Excel 2007 (maybe your data were quite different). My code in Post#13 took 0.11 secs for same data.

With 60,000 rows your code took 1.04 secs, mine took 0.25 secs.
With 100K rows yours gave type mismatch error, mine took 0.40 secs.
Wih 1 million rows, my code took 3.6secs. Yours gave type mismatch.

Whatever your preferred terminology, it could be said that your code is relatively slow. I took your use of "very fast" to be relative to other posts made in this thread, which is the obvious standard of comparison. If you didn't mean this (or even if you did), all OK by me, no problem to anyone.

Regarding data deletions, if you run your code on test data, then run it again on the re-ordered data, you should see gaps readily enough. The reason seems obvious enough - your deletion of the original ColumnA. Probably wouldn't matter for this thread, but for some matrix work (for example) where this kind of approach could be used it might matter a lot.