View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
Phrank Phrank is offline
external usenet poster
 
Posts: 153
Default Rearranging columns in a large spreadsheet

Good evening Claus and Garry,

I first tried changing the calculation to manual, but that had no
effect. I put the autocalc code in both the main macro and the sub
routine with the same result. Below is the code that gets run that
does indeed work, just very slow (this is part of a 'formatting'
macro, not too much else going on, but a little bit).

With wksSource
strHeaders = "Age
(Dynamic),ProView,INV#,CMPL#,PI#,Investigation Assigned
to,Investigation State,Op Lvl," & _
"Catalog #,User Notes,System Likely Rationale,My
Likely Rationale,System Rationale for Internal Testing," & _
"My Rationale for Internal Testing,Last
Reviewed,Product Long Description"
strCols = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P"
varHeaders = Split(strHeaders, ",")
varCols = Split(strCols, ",")

For i = LBound(varHeaders) To UBound(varHeaders)
Set c = Range("1:1").Find(varHeaders(i), , xlValues,
xlWhole)
If Not c Is Nothing Then
.Columns(c.Column).Cut
.Columns(varCols(i)).Insert Shift:=xlToRight
End If
Next
End With 'wksSource

And by the way, I tried simply copying a column and inserting it
elsewhere in the workbook, and I got the message stating it will
affect a lot of cells and take at least 60 seconds, or something to
that effect. There are about 5000 rows and 60 columns, and yes that's
big, but it's not that big. Why might it be doing that?

Regarding the code below, there are 61 columns total (up the CI), so
would I extend the alphabet line out to CI? Also, is there a way to
align the sCols constant with the header label? I think otherwise
I'll need to keep track of which row goes to which column, and if that
changes for whatever reason in the future, change this order also,
right?

Thank you both very much for your time looking at this and helping me!
It's very much appreciated!

Frank

On Mon, 15 Jun 2015 02:04:21 -0400, GS wrote:

Try this code in a standard module...

Option Explicit

Type udtAppModes
'Default types
Events As Boolean: CalcMode As XlCalculation: Display As Boolean:
CallerID As String
'Project-specific types
End Type
Public AppMode As udtAppModes


Sub ReorderCols()
Const sSource$ = "ReorderCols"
' Reorders cols based on a string list of col labels.
' Places the listed cols at the left edge of the sheet,
' in the order listed.

Const sColLabels$ =
"A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X, Y,Z"
Const sColsToReorder$ = "G,AA,F,R" '//edit to suit
Dim vColLabels, vOrder, vIn, rng As Range
Dim n&, k&, j&, lCol&
vColLabels = Split(sColLabels, ",")
vOrder = Split(sColsToReorder, ",")

EnableFastCode sSource
On Error GoTo ErrExit
With ActiveSheet
Set rng = .UsedRange: vIn = rng
'Get the col positions
For k = UBound(vOrder) To LBound(vOrder) Step -1
lCol = (Len(vOrder(k)) - 1) * 26
For n = LBound(vColLabels) To UBound(vColLabels)
If vColLabels(n) = Right$(vOrder(k), 1) Then lCol = lCol + n +
1: Exit For
Next 'n

'Shift the cols to the right
For j = 1 To rng.Rows.Count
For n = lCol - 1 To 1 Step -1
rng.Cells(j, n + 1) = rng.Cells(j, n)
Next 'n

'Insert the col
rng.Cells(j, 1) = vIn(j, lCol)
Next 'j
Next 'k
End With 'ActiveSheet

ErrExit:
Set rng = Nothing: EnableFastCode sSource, False
End Sub

Sub EnableFastCode(Caller$, Optional SetFast As Boolean = True)
' **Note: Requires 'Type udtAppModes' and 'Public AppMode As
udtAppModes' declarations

'The following will make sure only the Caller has control,
'and allows any Caller to take control when not in use.
If AppMode.CallerID < Caller Then _
If AppMode.CallerID < "" Then Exit Sub

With Application
If SetFast Then
AppMode.Display = .ScreenUpdating: .ScreenUpdating = False
AppMode.CalcMode = .Calculation: .Calculation =
xlCalculationManual
AppMode.Events = .EnableEvents: .EnableEvents = False
AppMode.CallerID = Caller
Else
.ScreenUpdating = AppMode.Display
.Calculation = AppMode.CalcMode
.EnableEvents = AppMode.Events
AppMode.CallerID = ""
End If
End With
End Sub