Move column in Excel 2007, extremely slow HELP!

[Laavista]

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

 

[Tom Urtis]

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?

 

[Laavista]

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 -->

 

[Tom Urtis]

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.

 

[Rick Rothstein]

Try explaining in words rather than code what you are doing.

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.

 

[Laavista]

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-comfficeffice" /><o></o>
<o> </o>
Sub FormatSupplierReport()
<o> </o>
Dim thelastrow As Long
Dim irow As Long
<o> </o>
<o> </o>
On Error GoTo ErrorHandler
<o> </o>
Worksheets("SupplierReport").Activate 'makes SupplierReport worksheet active
<o> </o>
thelastrow = 0
<o> </o>
irow = Cells(65536, "A").End(xlUp).Row
If irow > thelastrow Then thelastrow = irow
<o> </o>
<o> </o>
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> </o>
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> </o>
<o> </o>
ErrorHandler:
MsgBox "Error occurred in procedure FormatSupplierReport " & vbCrLf & "Error Desc: " & Err.Description & vbCrLf & "Error Number:" & Err.Number, vbCritical, "Error!"
Exit Sub
<o> </o>
End Sub

<o> </o>
<o> </o>
<o> </o>
<o> </o>

 

[Rick Rothstein]

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.

' [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

 

[Laavista]

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-comfficeffice" /><o></o>
Dim thelastrow As Long<o></o>
Dim CheckForBlankColumn as string<o></o>
<o></o>
<o></o>
Worksheets("SupplierReport").<o></o>
<o></o>
thelastrow = 0<o></o>
irow = Cells(65536, "A").End(xlUp).Row<o></o>
If irow > thelastrow Then thelastrow = irow<o></o>
<o></o>
With Sheets("SupplierReport").Range("A1:ae" & thelastrow)<o></o>
<o></o>
Application.AlertBeforeOverwriting = False 'turn off msg 'do you want to replace contents of cells'<o></o>
<o></o>
Application.DisplayAlerts = False<o></o>
<o></o>
Columns("C:C").Select<o></o>
Application.CutCopyMode = False<o></o>
Selection.Insert shift:=xlToRight<o></o>
Selection.Insert shift:=xlToRight<o></o>
Selection.Insert shift:=xlToRight<o></o>
Range("B9:B" & thelastrow).Select<o></o>
Selection.Copy<o></o>
Application.CutCopyMode = False<o></o>
Selection.TextToColumns Destination:=Range("B9"), DataType:=xlDelimited, _<o></o>
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _<o></o>
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _<o></o>
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True<o></o>
Range("D8").Select<o></o>
ActiveCell.FormulaR1C1 = "Cust ID"<o></o>
Range("C8").Select<o></o>
ActiveCell.FormulaR1C1 = "Order Date"<o></o>
Range("B8").Select<o></o>
ActiveCell.FormulaR1C1 = "Part #"<o></o>
‘ check if there is a blank column. If so, delete it<o></o>
CheckForBlankColumn = Worksheets("SupplierReport").Cells(8, "E")<o></o>
<o></o>
If CheckForBlankColumn = "" Then 'Have extra column<o></o>
Columns("E:E").Select<o></o>
Selection.Delete shift:=xlToLeft<o></o>
End If <o></o>
<o></o>
End with <o></o>
<o></o>
End Sub<o></o>
<o></o>

 

[Rick Rothstein]

You are quite welcome... I'm glad it worked out for you.

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

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.

 

[Laavista]

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!!