Cut and insert Columns using VBA

UseLessFuel

New Member
Joined
Dec 22, 2012
Messages
37
Hi. I have an Excel Worksheet with 241 columns and around 46 thousand rows of numbers (no blanks anywhere). I only require 9 (nine) columns from the sheet which should be placed in Columns B to J. From recording a macro, and deleting unnecessary cursor movements, I ended up with the following code. Is there a smoother way of using VBA to carry out the same actions, or is this as efficient as can be? Thanks for your interest.

Sub OrderFromRawSD()
'
' OrderFromRawSD Macro
' From raw data (.xlsx), simply press Ctrlq to arrange the correct columns.
'
' Keyboard Shortcut: Ctrl+q
'
Columns("CQ:CQ").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("CL:CL").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("CM:CM").Select
Selection.Cut
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Columns("CR:CR").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("CT:CT").Select
Selection.Cut
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Columns("CB:CB").Select
Selection.Cut
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("CD:CD").Select
Selection.Cut
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Columns("M:M").Select
Selection.Cut
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Columns("W:W").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Columns("K:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("L:BP").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
Columns("M:M").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
To answer your questions, the code is definitely not as efficient as it can be, but to address that, please explain if there is only one worksheet where (maybe) you want to delete column A and columns K:IG (IG being column number 241). Or, you might have 2 sheets, on one of which is the only-wanted data in the 9 columns of interest and you want to copy them into the monster sheet where you then would delete the unwanted other 232 columns.

None of my business but I'll ask anyway, why in the world is there so much data being produced that you don't even want?
 
Upvote 0
Hi Tom. For interest, I am researching time series (per minute) data from domestic heating systems, explaining the length of columns, but I have no idea why so many columns exist: about two thjrds of which contain all zeros.
I can only access 30 days of data at a time (contained in one sheet) so I extract the nine columns for each 30-day set and append onto a master file. I leave column A in place. I had used a MyLastRow sub to extend down to the last row of data but I messed it up somehow.
 
Upvote 0
You said:

I only require 9 (nine) columns from the sheet which should be placed in Columns B to J

I assume you want to leave column (1) in place with no changes.
What 9 columns do you want to keep?
And in what order do you want these column arranged.

So for example if you want to keep columns 20 30 40 60 etc.

Where should column 20 data be entered would it be column 2 and 30 would now be 3

Please provide these details if you would

Say for example

Copy column 30 to column 2
Copy column 60 to column 3

Then we delete all columns after column 10

Please do not say read my code and you will see what I want.
 
Upvote 0
Hi.


You are correct, I would like to leave Col (1) as is. Just to let you know that it would be ideal to leave the original data file as is, and extract the required columns to a new Workbook. My method was to cut and then insert the required columns within the original data file (worksheet within workbook) and then saved the resulting file with a new name (which left the original Workbook intact).
I have listed the original file column numbers below (and added a few additional data columns):


From the original worksheet:
Col (1) is to remain in Col (1)
Col (95) is to be placed in Col (2)
Col (89) is to be placed in Col (3)
Col (90) is to be placed in Col (4)
Col (96) is to be placed in Col (5)
Col (98) is to be placed in Col (6)
A change here: I would like Col (7) to contain Col (5) minus Col (6) e.g. in cell G2 to equal the result of (F2-G2) etc. all down the column
Col (75) is to be placed in Col (8)
Col (77) is to be placed in Col (9)
Col (6) is to be placed in Col (10)
Col (16) is to be placed in Col (11)
I would then like for Col (12) to be blank.
Last three addiitional columns, I would like to add:
Col (83) is to be placed in Col (13)
Col (84) is to be placed in Col (14)
Col (85) is to be placed in Col (15)


I do not need the remaining columns of data, so they can be deleted if the above is conducted in the original worksheet. I will then save the reulting file as a different name, as mentioned earlier.
Sorry if this is asking too much. My first row contains headers, the remaing rows contain data (numbers) with no blank entries.
Best regards.
 
Upvote 0
How about
Code:
Sub CopyColumns()

   Dim Ary As Variant
   Dim Cnt As Long
   Dim Wbk As Workbook
   Dim Ws As Worksheet
   
   Ary = Array(1, 95, 89, 90, 96, 98, 16384, 75, 77, 6, 16, 16384, 83, 84, 85)
   
   With ActiveSheet
      Set Wbk = Workbooks.Add
      Set Ws = Wbk.Sheets(1)
      For Cnt = LBound(Ary) To UBound(Ary)
         .Columns(Ary(Cnt)).Copy Ws.Columns(Cnt + 1)
      Next Cnt
   End With
   Ws.Range("G2", Range("F" & Rows.Count).End(xlUp).Offset(, 1)).Formula = "=E2-F2"
End Sub
 
Upvote 0
Hi Fluff.
I am in awe. Your code worked perfectly, with such few lines, and took about one second for 30 days of data.

I understand (partly) the Dim setting of variables i.e. I'll have to look up Variant. I presume that LBound (Ary) relates to the first cell of each column, defined by the Array(x, y, ...) and UBound relates to the last (non-empty) cell of the same column (again, I will have to look this up).

I also presume that .Columns(Ary(Cnt)).Copy Ws.Columns(Cnt + 1) somehow places the next count (column of data) into the next column of the newly created Worksheet.

The last line of code, prior to End Sub, I partly understand also. All in all, I think that your short code is brilliant and I really appreciate your knowledge. Thanks to Tom, My Answer Is This and to you Fluff.
 
Upvote 0
Correction to my previous post#7: LBound (Ary) refers to the first number (column) in array, which is (1) while UBound(Ary) refers to the last number in array, which is (85). I assume that 16384's in the array refers to a blank column which is placed in Column G and Column L.
 
Upvote 0
As long as you have less than 65,535 rows of data, then here is another macro that you can consider. What makes this macro interesting is that it uses no loops.
Code:
[table="width: 500"]
[tr]
	[td]Sub CopyColumns2()
  Dim LastRow As Long, Arr As Variant, Wbk As Workbook, Ws As Worksheet
  Arr = Array(1, 95, 89, 90, 96, 98, 16384, 75, 77, 6, 16, 16384, 83, 84, 85)
  With ActiveSheet
    LastRow = .Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
    Set Wbk = Workbooks.Add
    Set Ws = Wbk.Sheets(1)
    Ws.Range("A1").Resize(LastRow, UBound(Arr)) = Application.Index(.Cells, Evaluate("ROW(1:" & LastRow & ")"), Arr)
  End With
  Ws.Range("G2", Range("F" & Rows.Count).End(xlUp).Offset(, 1)).Formula = "=E2-F2"
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Thanks Rick. Your code works well, except for the last column (15) which is missing.
From post#5 above, Col (85) is to be placed in Col (15).

I appreciate your input.
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,264
Members
452,627
Latest member
KitkatToby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top