Hi,

I've got a large spreadsheet (goes to column CF), which is created
from another set of macros that pull in data from multiple sources.
After the spreadsheet is created, I would like to reorder the columns
in a more consumable order. How would I go about looping through the
columns to get the header names, and then putting the columns that I
want more to the front of the spreadsheet where the user will
immediately see the data when the workbook is opened? Thanks for any
advice.

Frank

Hi Frank,

Am Mon, 08 Jun 2015 00:59:09 -0400 schrieb Phrank:

I've got a large spreadsheet (goes to column CF), which is created
from another set of macros that pull in data from multiple sources.
After the spreadsheet is created, I would like to reorder the columns
in a more consumable order. How would I go about looping through the
columns to get the header names, and then putting the columns that I
want more to the front of the spreadsheet where the user will
immediately see the data when the workbook is opened?

try:

Sub MoveCols()
Dim strCols As String, strHeaders As String
Dim varCols As Variant, varHeaders As Variant
Dim c As Range
Dim i As Long

Application.ScreenUpdating = False
'Modify the headers and the target columns
'In this example the column with "Header10" goes to column B
'column with "Header12" goes to column D and so on
strHeaders = "Header10,Header12,Header20,Header28,Header35,Head er40"
strCols = "B,D,E,G,H,I"
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
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

I'll give that a try tonight and get back to you. Thank you!!

Frank

On Mon, 8 Jun 2015 09:55:59 +0200, Claus Busch
wrote:

Hi Frank,

Am Mon, 08 Jun 2015 00:59:09 -0400 schrieb Phrank:

I've got a large spreadsheet (goes to column CF), which is created
from another set of macros that pull in data from multiple sources.
After the spreadsheet is created, I would like to reorder the columns
in a more consumable order. How would I go about looping through the
columns to get the header names, and then putting the columns that I
want more to the front of the spreadsheet where the user will
immediately see the data when the workbook is opened?

try:

Sub MoveCols()
Dim strCols As String, strHeaders As String
Dim varCols As Variant, varHeaders As Variant
Dim c As Range
Dim i As Long

Application.ScreenUpdating = False
'Modify the headers and the target columns
'In this example the column with "Header10" goes to column B
'column with "Header12" goes to column D and so on
strHeaders = "Header10,Header12,Header20,Header28,Header35,Head er40"
strCols = "B,D,E,G,H,I"
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
Application.ScreenUpdating = True
End Sub


Regards
Claus B.

Hi Claus,

Sorry for the delay in getting back to you, work got in the way and I
wasn't able to get back at this right away. I did today, though, and
this code works brilliantly! The only downside I've found from the
code is that it is fairly slow. The workbook is fairly large, having
62 columns and about 5000 rows. I'm moving around 14 columns, and it
takes roughly 3-4 minutes for the code to execute. Is that normal? Is
there something I might be able to do to speed that up? Even if I
can't, the results are outstanding! Thank you very much for your
help!

Frank

On Mon, 8 Jun 2015 09:55:59 +0200, Claus Busch
wrote:

Hi Frank,

Am Mon, 08 Jun 2015 00:59:09 -0400 schrieb Phrank:

I've got a large spreadsheet (goes to column CF), which is created
from another set of macros that pull in data from multiple sources.
After the spreadsheet is created, I would like to reorder the columns
in a more consumable order. How would I go about looping through the
columns to get the header names, and then putting the columns that I
want more to the front of the spreadsheet where the user will
immediately see the data when the workbook is opened?

try:

Sub MoveCols()
Dim strCols As String, strHeaders As String
Dim varCols As Variant, varHeaders As Variant
Dim c As Range
Dim i As Long

Application.ScreenUpdating = False
'Modify the headers and the target columns
'In this example the column with "Header10" goes to column B
'column with "Header12" goes to column D and so on
strHeaders = "Header10,Header12,Header20,Header28,Header35,Head er40"
strCols = "B,D,E,G,H,I"
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
Application.ScreenUpdating = True
End Sub


Regards
Claus B.

Hi Frank,

Am Sun, 14 Jun 2015 20:52:14 -0400 schrieb Phrank:

I did today, though, and
this code works brilliantly! The only downside I've found from the
code is that it is fairly slow. The workbook is fairly large, having
62 columns and about 5000 rows. I'm moving around 14 columns, and it
takes roughly 3-4 minutes for the code to execute. Is that normal? Is
there something I might be able to do to speed that up?

do the columns have formulas? Then set Calculation to "Manual" before
running the macro.
If that does not speed up the macro please post the macro with the
modifications you made.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

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

Hi Frank,

Am Sun, 14 Jun 2015 20:52:14 -0400 schrieb Phrank:

I did today, though, and
this code works brilliantly! The only downside I've found from the
code is that it is fairly slow. The workbook is fairly large,
having 62 columns and about 5000 rows. I'm moving around 14
columns, and it takes roughly 3-4 minutes for the code to execute.
Is that normal? Is there something I might be able to do to speed
that up?

do the columns have formulas? Then set Calculation to "Manual" before
running the macro.
If that does not speed up the macro please post the macro with the
modifications you made.


Regards
Claus B.

OP states "..pull in *data* from multiple sources" which suggests that
there are no formulas!

--
Garry

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

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

The workbook that this code is being applied to is created from
another set of macros that pull in data from multiple sources. My
macro simply takes that previously created worksheet and more properly
formats it for better end user consumption.

That said, I'm wondering if this is about how that workbook is
created. Part of my formatting code inserts 3 brand new columns where
the user will be able to enter notes. That code runs just fine. Then
we get to the column resorting code, which runs slow.

But that said, the current iteration goes to line 4846 (last row is
dynamic). Everything below that row is blank, i.e., grayed out). I
actually was able to select the last row and next row and 'unhide' for
the rest of the rows to show up. Same thing with all columns past CI.
I unhid and cleared all, but I'm still not able to cut a column and
insert it at a different location.

Any ideas on what my be going on? And by the way, I realize this
started out as VBA and may now have moved outside that scope, so
please let me know if I need to move this question to a different
forum. Thanks!

Frank

On Tue, 16 Jun 2015 22:44:49 -0400, Phrank wrote:

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

hi Frank,

you might format another sheet and then transfer only your data values,
exemple:
Sheets("2").Range("A1:A5000").Value = Sheets("1").Range("C1:C5000").Value
Sheets("2").Range("B1:B5000").Value = Sheets("1").Range("F1:F5000").Value

isabelle

Your code runs slow because it uses Cut/Insert! Try my approach, ..it
just moves the data and so should be orders of magnitude faster.


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?

I don't understand this! I thought you wanted to reorder cols and so
what does it have to do with rows? (All cols have rows! All rows have
cols!)

Assuming your headers are in row 1, the col labels are directly above.
If you want to specify fieldnames to reorder then a different approach
needs to be used...

If, as you suggest, the reorder will change often then I'm thinking a
userform that displays fieldnames (col headers) in a listbox where you
can move a selected fieldname up/down. Click a button and it's done!

OR

You could use 2 listboxes where you can add the reorder fieldnames to
the 2nd listbox, then reorder them as desired, then click a button.

Regardless, this isn't going to be a trivial project, meaning
programming experience is required beyond writing simple macros!

--
Garry

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

Hi Frank,

Am Tue, 16 Jun 2015 22:44:49 -0400 schrieb Phrank:

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

you don' t need strCols because your columns will go one by one.
Following code does that in a blink. If it works slow on your machine
the rest of your code causes that issue:

Sub Test()
Dim wksSource As Worksheet
Dim strHeaders As String
Dim varHeaders As Variant
Dim i As Long, c As Range

Set wksSource = Sheets("Sheet1")

Application.ScreenUpdating = False
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,LastReviewed,Product Long Description"
varHeaders = Split(strHeaders, ",")

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


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi, just touching base again. I haven't been able to get back at this
yet, but I will be tonight and this weekend. I'll post back with
results. Thank you!!

On Wed, 17 Jun 2015 08:26:57 +0200, Claus Busch
wrote:

Hi Frank,

Am Tue, 16 Jun 2015 22:44:49 -0400 schrieb Phrank:

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

you don' t need strCols because your columns will go one by one.
Following code does that in a blink. If it works slow on your machine
the rest of your code causes that issue:

Sub Test()
Dim wksSource As Worksheet
Dim strHeaders As String
Dim varHeaders As Variant
Dim i As Long, c As Range

Set wksSource = Sheets("Sheet1")

Application.ScreenUpdating = False
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,LastReviewed,Product Long Description"
varHeaders = Split(strHeaders, ",")

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


Regards
Claus B.

Hi Claus and Garry,

I was finally able to get back to this and finish it up. The code
below works like a champ now - and fast too. There was (is?) and
issue with the way the workbook is initially compiled, and i believe a
few other lines of my code where i was inseting 4 columns at column A
contributed to the layout/formatting issue. Those other lines of code
worked well where they were placed, but after adjusting and and moving
those, all fell into place. I still insert those four columns, but
before I was inserting the columns and then moving them around with
your code. Now I run your code and then insert the four new columns
into the location where I want them. Not sure why inserting columns
up front would cause the slow down I experienced, but it did.

Garry, your code probably works well, but I had already started down
the road with this code, and with my current level and time
constraints at work, it was a lot easier for me to try and figure this
one out. As you said (and I realize), there are some things that we
will simply need better and more experienced programmers to create.

Thank you both VERY much for your time and help!

Best regards,

Frank

On Wed, 17 Jun 2015 08:26:57 +0200, Claus Busch
wrote:

Hi Frank,

Am Tue, 16 Jun 2015 22:44:49 -0400 schrieb Phrank:

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

you don' t need strCols because your columns will go one by one.
Following code does that in a blink. If it works slow on your machine
the rest of your code causes that issue:

Sub Test()
Dim wksSource As Worksheet
Dim strHeaders As String
Dim varHeaders As Variant
Dim i As Long, c As Range

Set wksSource = Sheets("Sheet1")

Application.ScreenUpdating = False
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,LastReviewed,Product Long Description"
varHeaders = Split(strHeaders, ",")

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


Regards
Claus B.