View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
GS[_6_] GS[_6_] is offline
external usenet poster
 
Posts: 1,182
Default Rearranging columns in a large spreadsheet

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

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion