Move column in Excel 2007, extremely slow HELP!

L

Laavista

Board Regular
Joined
Aug 27, 2009
Messages
79
I'm using Excel 2007 (operating system is Windows 7). Since changing my VBA program from Excel 2003 to Excel 2007, moving a column is extremely slow. I have a program that has to move 5 columns in a specific order, and it's taking 10+ minutes. I have 4000 rows of data

I originally selected the entire column, cut it, then inserted the cut cells.
I thought if I would select the specific rows, then cut it and insert just those rows that it would be faster, but if it is, it is not noticeable.

I desperately need help.

My code:
Objective: Move column f to column b. Data begins in row 8

Sub test()

Dim thelastrow as long
Dim irow as long

'find the last row
irow = cells(65536, "A").End(xlUp).Row
If irow > thelastrow Then thelastrow = irow

Range ("F8:F" & thelastrow).Select
Selection.Cut
Range("b8:b" & thelastrow).Select
Selection.Insert Shift:=xlToRight

End Sub
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
Considering this line:
If irow > thelastrow Then thelastrow = irow

where is it exactly that you defined what row the "thelastrow" variable is, prior to that line appearing in your posted code?
 
Upvote 0
Sorry, I was working on two computers and typed the code in instead of copying it and missed that line.

Corrected code:

Sub test()

Dim thelastrow as long
Dim irow as long

thelastrow = 0

'find the last row
irow = cells(65536, "A").End(xlUp).Row
If irow > thelastrow Then thelastrow = irow

Range ("F8:F" & thelastrow).Select
Selection.Cut
Range("b8:b" & thelastrow).Select
Selection.Insert Shift:=xlToRight

End Sub <!-- / message -->
 
Upvote 0
Well, every row will be a number greater than zero, but I still don't get what you are cutting, and where you are shifting columns.

Is B going to F?

Is B being shifted or is F being shifted?

Try explaining in words rather than code what you are doing. This should be a very quick code execution.
 
Upvote 0
Tom Urtis said:
Try explaining in words rather than code what you are doing.
Click to expand...
And to follow up on Tom's request... also tell us all of the columns you need to move and to where... don't just ask for part of a solution... we may be able to give you code that is different than you are envisioning which may be able to do everything at once... but before we can decide, we need to know the facts.
 
Upvote 0
Thank you both. Good suggestions. I'll be sure to do both in the future.

I have to rearrange the columns in the following order.

' column D move to column B (B moves to the right)
' new column D moves to C (C moves to the right)
' column P moves to M (M moves to the right)
' column R moves to N (N moves to the right)
' columns Q thru R moves to O (O moves to the right

My code:

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<o:p> </o:p>
Sub FormatSupplierReport()
<o:p> </o:p>
Dim thelastrow As Long
Dim irow As Long
<o:p> </o:p>
<o:p> </o:p>
On Error GoTo ErrorHandler
<o:p> </o:p>
Worksheets("SupplierReport").Activate 'makes SupplierReport worksheet active
<o:p> </o:p>
thelastrow = 0
<o:p> </o:p>
irow = Cells(65536, "A").End(xlUp).Row
If irow > thelastrow Then thelastrow = irow
<o:p> </o:p>
<o:p> </o:p>
With Sheets("SupplierReport").Range("A1:AE" & thelastrow)

' column D move to column B (B moves to the right)
' new column D moves to C (C moves to the right)
' column P moves to M (M moves to the right)
' column R moves to N (N moves to the right)
' columns Q thru R moves to O (O moves to the right

' move columns.
Columns("D:D").Select 'move to column B
Selection.Cut
Columns("B:B").Select
Selection.Insert shift:=xlToRight
Columns("D:D").Select ' move to col C
Selection.Cut
Columns("C:C").Select
Selection.Insert shift:=xlToRight
<o:p> </o:p>
Columns("P:P").Select 'move P to M
Selection.Cut
Columns("M:M").Select
Selection.Insert shift:=xlToRight
Columns("R:R").Select 'move R to N
Selection.Cut
Columns("N:N").Select
Selection.Insert shift:=xlToRight
Columns("Q:R").Select 'move columns Q thru R to O
Selection.Cut
Columns("O:O").Select
Selection.Insert shift:=xlToRight

End With

Exit Sub
<o:p> </o:p>
<o:p> </o:p>
ErrorHandler:
MsgBox "Error occurred in procedure FormatSupplierReport " & vbCrLf & "Error Desc: " & Err.Description & vbCrLf & "Error Number:" & Err.Number, vbCritical, "Error!"
Exit Sub
<o:p> </o:p>
End Sub

<o:p> </o:p>
<o:p> </o:p>
<o:p> </o:p>
<o:p> </o:p>
 
Upvote 0
You changed something! Earlier you said you wanted to move data from Row 8 downward... now you are saying you want to move whole columns of your data. I added a StartRow constant (the Const statement) which will allow you to control this... I set it to 8 in the code below because that was your original request, but if you really want whole columns of your data instead, then just change the 8 to a 1 in that Const statement.
Code: 
' [B][COLOR=darkred]NOTE: THIS CODE IS ONLY GOOD FOR CONSTANT DATA, NOT FORMULA DATA[/COLOR][/B]
Sub MoveColumnsAround()
  Dim NewColumnNumberOrder As String, LastRow As Long, Cols As Variant
  Const StartRow As Long = 8
  LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  Application.ScreenUpdating = False
 
  ' Column Letter Order:  D C B
  NewColumnNumberOrder = "4 3 2"
  Cols = Application.Index(Cells, Evaluate("Row(" & StartRow & ":" & LastRow & ")"), Split(NewColumnNumberOrder))
  Range("B" & StartRow & ":D" & LastRow).Clear
  Range("B" & StartRow).Resize(LastRow - StartRow + 1, UBound(Split(NewColumnNumberOrder)) + 1) = Cols
 
  ' Column Letter Order:  P  M  O  Q  R  N
  NewColumnNumberOrder = "16 13 15 17 18 14"
  Cols = Application.Index(Cells, Evaluate("Row(" & StartRow & ":" & LastRow & ")"), Split(NewColumnNumberOrder))
  Range("M" & StartRow & ":R" & LastRow).Clear
  Range("M" & StartRow).Resize(LastRow - StartRow + 1, UBound(Split(NewColumnNumberOrder)) + 1) = Cols
 
  Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
This is INCREDIBLE! It's so fast! THANK YOU SO MUCH.

The reason I changed to start with row 8 and down--
I read in the forum where another person was copying an entire column, and the response they received to speed things up was to just copy the row that has the data and down.

I'm not sure of forum etiquette, but I have one more column split/move that takes an incredible amount of time. I will list my question below, but if I need to start a new thread, just let me know.

Thanks again for taking the time to help me. It is so appreciated!

====

Another major time consumer, is splitting data in 1 column into 3 columns.

Supplier has 3 sets of data in column C—need to split into 3 columns (C,D,E)
<TABLE style="WIDTH: 157pt; BORDER-COLLAPSE: collapse; MARGIN-LEFT: 4.65pt" class=ecxMsoNormalTable border=0 cellSpacing=0 cellPadding=0 width=209><TBODY><TR style="HEIGHT: 15pt"><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 157pt; PADDING-RIGHT: 5.4pt; HEIGHT: 15pt; PADDING-TOP: 0in" vAlign=bottom width=209 noWrap>COL C
Part#, OrderDate, CustID

</TD></TR><TR style="HEIGHT: 15pt"><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 157pt; PADDING-RIGHT: 5.4pt; HEIGHT: 15pt; PADDING-TOP: 0in" vAlign=bottom width=209 noWrap>11-12345 07/23/11 12384858

</TD></TR><TR style="HEIGHT: 15pt"><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 157pt; PADDING-RIGHT: 5.4pt; HEIGHT: 15pt; PADDING-TOP: 0in" vAlign=bottom width=209 noWrap>11-3838212 07/21/11 55555

</TD></TR><TR style="HEIGHT: 15pt"><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 157pt; PADDING-RIGHT: 5.4pt; HEIGHT: 15pt; PADDING-TOP: 0in" vAlign=bottom width=209 noWrap>11-998877 07/13/11 4747474

</TD></TR></TBODY></TABLE>

need to split as follows:
Column C = Part#
Column D = OrderDate
Column E = CustID

<TABLE style="WIDTH: 438.15pt; BORDER-COLLAPSE: collapse; MARGIN-LEFT: 4.65pt" class=ecxMsoNormalTable border=0 cellSpacing=0 cellPadding=0 width=584><TBODY><TR style="HEIGHT: 15pt"><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 290.3pt; PADDING-RIGHT: 5.4pt; HEIGHT: 15pt; PADDING-TOP: 0in" vAlign=bottom width=387 noWrap>COL C COL D COL E
<TABLE style="WIDTH: 287.65pt; BORDER-COLLAPSE: collapse" class=ecxMsoNormalTable border=0 cellSpacing=0 cellPadding=0 width=384><TBODY><TR style="HEIGHT: 14.5pt"><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 124.1pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=165>Part#

</TD><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 76.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=102> OrderDate

</TD><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 87pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=116> CustID

</TD></TR><TR style="HEIGHT: 14.5pt"><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 124.1pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=165>11-12345
​
</TD><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 76.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=102>
7/23/2011

​
</TD><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 87pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=116>
12384858​


</TD></TR><TR style="HEIGHT: 14.5pt"><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 124.1pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=165>11-3838212
​
</TD><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 76.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=102>
7/21/2011

​
</TD><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 87pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=116>
55555​


</TD></TR><TR style="HEIGHT: 14.5pt"><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 124.1pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=165>11-998877
​
</TD><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 76.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=102>
7/13/2011

​
</TD><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 87pt; PADDING-RIGHT: 5.4pt; HEIGHT: 14.5pt; PADDING-TOP: 0in" vAlign=top width=116>
4747474​


</TD></TR></TBODY></TABLE>
</TD><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 69.1pt; PADDING-RIGHT: 5.4pt; HEIGHT: 15pt; PADDING-TOP: 0in" vAlign=bottom width=92 noWrap></TD><TD style="PADDING-BOTTOM: 0in; PADDING-LEFT: 5.4pt; WIDTH: 78.75pt; PADDING-RIGHT: 5.4pt; HEIGHT: 15pt; PADDING-TOP: 0in" vAlign=bottom width=105 noWrap></TD></TR></TBODY></TABLE>
====
MY CODE:

Sub SplitSupplierColumns()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
Dim thelastrow As Long<o:p></o:p>
Dim CheckForBlankColumn as string<o:p></o:p>
<o:p></o:p>
<o:p></o:p>
Worksheets("SupplierReport").<o:p></o:p>
<o:p></o:p>
thelastrow = 0<o:p></o:p>
irow = Cells(65536, "A").End(xlUp).Row<o:p></o:p>
If irow > thelastrow Then thelastrow = irow<o:p></o:p>
<o:p></o:p>
With Sheets("SupplierReport").Range("A1:ae" & thelastrow)<o:p></o:p>
<o:p></o:p>
Application.AlertBeforeOverwriting = False 'turn off msg 'do you want to replace contents of cells'<o:p></o:p>
<o:p></o:p>
Application.DisplayAlerts = False<o:p></o:p>
<o:p></o:p>
Columns("C:C").Select<o:p></o:p>
Application.CutCopyMode = False<o:p></o:p>
Selection.Insert shift:=xlToRight<o:p></o:p>
Selection.Insert shift:=xlToRight<o:p></o:p>
Selection.Insert shift:=xlToRight<o:p></o:p>
Range("B9:B" & thelastrow).Select<o:p></o:p>
Selection.Copy<o:p></o:p>
Application.CutCopyMode = False<o:p></o:p>
Selection.TextToColumns Destination:=Range("B9"), DataType:=xlDelimited, _<o:p></o:p>
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _<o:p></o:p>
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _<o:p></o:p>
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True<o:p></o:p>
Range("D8").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Cust ID"<o:p></o:p>
Range("C8").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Order Date"<o:p></o:p>
Range("B8").Select<o:p></o:p>
ActiveCell.FormulaR1C1 = "Part #"<o:p></o:p>
‘ check if there is a blank column. If so, delete it<o:p></o:p>
CheckForBlankColumn = Worksheets("SupplierReport").Cells(8, "E")<o:p></o:p>
<o:p></o:p>
If CheckForBlankColumn = "" Then 'Have extra column<o:p></o:p>
Columns("E:E").Select<o:p></o:p>
Selection.Delete shift:=xlToLeft<o:p></o:p>
End If <o:p></o:p>
<o:p></o:p>
End with <o:p></o:p>
<o:p></o:p>
End Sub<o:p></o:p>
<o:p></o:p>
 
Upvote 0
You are quite welcome... I'm glad it worked out for you.

As for your new question, give this macro a try...

Code: 
Sub SplitData()
  Const StartRow As Long = 2
  Const DataColumn As String = "C"
  Range(Cells(StartRow, DataColumn), Cells(Rows.Count, DataColumn).End(xlUp)).TextToColumns , Destination:=Cells(StartRow, _
        DataColumn), DataType:=xlDelimited, Tab:=False, Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
        FieldInfo:=Array(Array(1, xlGeneralFormat), Array(2, xlMDYFormat), Array(3, xlTextFormat))
End Sub
Note that you can also do this without the use of a macro. Select your data cells in Column C, click the "Data" tab and then click the "Text to Columns" button in the "Data Tools" group, select "Delimited" on Step 1 of 3 and click the "Next" button, make "Space" the only checkbox that is checked and click the "Next" button. Now click each column in the table one at a time and select the appropriate "Column data format" option button for them. I used "General", "Date" with MDY in the drop down box, and Text in my code above. Note... the reason I chose "Text" for your third column is because you said it is an ID number and you must use Text format in case it can contain leading zeroes. Finally, click the "Finish" button.
 
Upvote 0
Rick, you have been wonderful! The new code worked well.

Thanks for taking the time out of your busy schedule to share your knowledge.

Thanks again!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Macro To Move Files - Will Not Move .msg or .csv files
Replies
4
Views
105
rachel06
R
J
  • Question Question
VBA or formula to move data in last used column to column A
Replies
5
Views
194
Peter_SSs
Peter_SSs
S
  • Solved
Move row based on cell color
Replies
3
Views
342
jolivanes
jolivanes
B
  • Solved
VBA to Move Rows Based on Status in Excel
Replies
3
Views
593
Alex Blakenburg
A
B
  • Solved
Use Sheet1:D5 to find matching cell in Sheet2 Column A:A, and select cell (or row)
Replies
1
Views
424
brianv
B

Forum statistics

Threads
1,224,600
Messages
6,179,836
Members
452,947
Latest member
Gerry_F

Share this page

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