A Better Way to Reorganize Data?

D

Damian Carrillo

I've been providing interim solutions for financial issues our full-
fledged developers do not have time to address. Some of the interim
solutions have a way of becoming defacto permanent solutions.

I'm always trying to find ways to build a better mousetrap but my code-
clean-up efforts have hit a wall. The first part of the following is
a snippet of code originally created by recording a macro.

The purpose of the code is to manipulate a data file from a vendor so
it is in a state that suits the end-user's needs (ie technophobic
comfort zone) so they can do an extensive amount of error checking and
data entry completion. One of the primary tasks is changing the order
in which the columns appear.

I find it hard to believe what I have devised is the only way to
manipulate columns of data. Surely there's a cleaner/more streamlined
way of accomplishing this functionality? I've made heavy use of
subroutine calls to shorten the amount of repetative code. I can also
post those modules if it would be helpful.


'Begin reformatting layout of travel bill reconcilliation from
Navagant
ActiveWindow.Zoom = 75
Sheets(1).Select
ActiveSheet.Columns("M:O").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(2).Select
ActiveSheet.Columns("H:I").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(1).Select

'Copies the column headers from the main sheet to the unmatched
sheet for debugging purposes only
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ResetRange

'Reposition COMMENTS Field from Column 7 to Column 13
ActiveSheet.Cells(2, 7).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 11).Select
ActiveSheet.Paste

'Reposition AMOUNT Field from Column 6 to Column 8
ActiveSheet.Cells(2, 6).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 8).Select
ActiveSheet.Paste

'Reposition DEPDATE Field from Column 3 to Column 7
ActiveSheet.Cells(2, 3).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 7).Select
ActiveSheet.Paste

'Reposition TICKET Field from Column 4 to Column 3
ActiveSheet.Cells(2, 4).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 3).Select
ActiveSheet.Paste

'Reposition AIRLINE Field from Column 5 to Column 4
ActiveSheet.Cells(2, 5).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 4).Select
ActiveSheet.Paste

'Copy Repositioned Data Block to Main Sheet
ActiveSheet.Rows("1:2").EntireRow.Select
Selection.Delete
ActiveSheet.Cells(1, 1).Select
ResetRange
SelectActiveArea
Selection.Cut
Sheets(1).Select
GotoStartOfRow
GotoBottom
GotoStartOfRow
MoveDown
Selection.Insert Shift:=xlDown
GotoStartOfRow
GotoBottom
MoveDown
MoveUp
ActiveCell.Select
LastRow = ActiveCell.Row

'Create Key Field for all records
Sheets(1).Cells(1, 13).Select
ActiveCell.FormulaR1C1 = "Key"
Sheets(1).Cells(2, 13).Select
AnalyzerFormula = "='AirTravelBill Assistant.xls'!
AnalyzeTravelBill(RC[-12],RC[-8],RC[-4],RC[-5],RC[-2],RC[-6],RC[-1],RC[-9])"
For Counter = 2 To LastRow
Cells(Counter, 13).FormulaR1C1 = AnalyzerFormula
Next Counter
GotoTop
ActiveCell.Select
Let Worksheets(1).Range("R1").Value = "2"

'Active AutoFilter and sort records by error type
Selection.AutoFilter
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort _
Key1:=ActiveSheet.Columns("M"), _
Order1:=xlDescending, _
Header:=xlYes
Range("A1:M1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium,
ColorIndex:=xlColorIndexAutomatic
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlMedium
.Borders(xlInsideVertical).ColorIndex = xlAutomatic
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
End With

With Workbooks("Travel.xls").Worksheets(1)
EnginesOnline
.Activate
.Range("A2").Select
ActiveWindow.FreezePanes = True
EnginesOffline
End With

ActiveCell.offset(-1, 0).Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.EntireRow.AutoFit
On Error Resume Next 'In case there are no Blanks
Columns("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange Key

Let Worksheets(1).Range("R1").Value = "3"
On Error GoTo 0 'Stop subroutine if unable to save file
ActiveWorkbook.Save 'Save new dataset
Windows("Travel.xls").Activate
EnginesOnline
'ActiveWindow.Close SaveChanges:=True 'Close source document
'Kill FilePath & "\TravelTemp.xls"
End Sub
 
D

Don Guillett

It appears you could use professional help but maybe this will make your
life a bit better.

Sub movecol()'whole column
Cells(1, 5).EntireColumn.Cut
Cells(1, 8).Insert
End Sub

Sub movecol1() 'rows 2:100
Range(Cells(2, 5), Cells(100, 5)).Cut
Cells(2, 8).Insert
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Damian Carrillo said:
I've been providing interim solutions for financial issues our full-
fledged developers do not have time to address. Some of the interim
solutions have a way of becoming defacto permanent solutions.

I'm always trying to find ways to build a better mousetrap but my code-
clean-up efforts have hit a wall. The first part of the following is
a snippet of code originally created by recording a macro.

The purpose of the code is to manipulate a data file from a vendor so
it is in a state that suits the end-user's needs (ie technophobic
comfort zone) so they can do an extensive amount of error checking and
data entry completion. One of the primary tasks is changing the order
in which the columns appear.

I find it hard to believe what I have devised is the only way to
manipulate columns of data. Surely there's a cleaner/more streamlined
way of accomplishing this functionality? I've made heavy use of
subroutine calls to shorten the amount of repetative code. I can also
post those modules if it would be helpful.


'Begin reformatting layout of travel bill reconcilliation from
Navagant
ActiveWindow.Zoom = 75
Sheets(1).Select
ActiveSheet.Columns("M:O").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(2).Select
ActiveSheet.Columns("H:I").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(1).Select

'Copies the column headers from the main sheet to the unmatched
sheet for debugging purposes only
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ResetRange

'Reposition COMMENTS Field from Column 7 to Column 13
ActiveSheet.Cells(2, 7).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 11).Select
ActiveSheet.Paste

'Reposition AMOUNT Field from Column 6 to Column 8
ActiveSheet.Cells(2, 6).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 8).Select
ActiveSheet.Paste

'Reposition DEPDATE Field from Column 3 to Column 7
ActiveSheet.Cells(2, 3).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 7).Select
ActiveSheet.Paste

'Reposition TICKET Field from Column 4 to Column 3
ActiveSheet.Cells(2, 4).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 3).Select
ActiveSheet.Paste

'Reposition AIRLINE Field from Column 5 to Column 4
ActiveSheet.Cells(2, 5).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 4).Select
ActiveSheet.Paste

'Copy Repositioned Data Block to Main Sheet
ActiveSheet.Rows("1:2").EntireRow.Select
Selection.Delete
ActiveSheet.Cells(1, 1).Select
ResetRange
SelectActiveArea
Selection.Cut
Sheets(1).Select
GotoStartOfRow
GotoBottom
GotoStartOfRow
MoveDown
Selection.Insert Shift:=xlDown
GotoStartOfRow
GotoBottom
MoveDown
MoveUp
ActiveCell.Select
LastRow = ActiveCell.Row

'Create Key Field for all records
Sheets(1).Cells(1, 13).Select
ActiveCell.FormulaR1C1 = "Key"
Sheets(1).Cells(2, 13).Select
AnalyzerFormula = "='AirTravelBill Assistant.xls'!
AnalyzeTravelBill(RC[-12],RC[-8],RC[-4],RC[-5],RC[-2],RC[-6],RC[-1],RC[-9])"
For Counter = 2 To LastRow
Cells(Counter, 13).FormulaR1C1 = AnalyzerFormula
Next Counter
GotoTop
ActiveCell.Select
Let Worksheets(1).Range("R1").Value = "2"

'Active AutoFilter and sort records by error type
Selection.AutoFilter
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort _
Key1:=ActiveSheet.Columns("M"), _
Order1:=xlDescending, _
Header:=xlYes
Range("A1:M1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium,
ColorIndex:=xlColorIndexAutomatic
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlMedium
.Borders(xlInsideVertical).ColorIndex = xlAutomatic
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
End With

With Workbooks("Travel.xls").Worksheets(1)
EnginesOnline
.Activate
.Range("A2").Select
ActiveWindow.FreezePanes = True
EnginesOffline
End With

ActiveCell.offset(-1, 0).Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.EntireRow.AutoFit
On Error Resume Next 'In case there are no Blanks
Columns("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange Key

Let Worksheets(1).Range("R1").Value = "3"
On Error GoTo 0 'Stop subroutine if unable to save file
ActiveWorkbook.Save 'Save new dataset
Windows("Travel.xls").Activate
EnginesOnline
'ActiveWindow.Close SaveChanges:=True 'Close source document
'Kill FilePath & "\TravelTemp.xls"
End Sub
 
G

George Nicholson

Instead of:
'Reposition COMMENTS Field from Column 7 to Column 13
ActiveSheet.Cells(2, 7).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 11).Select
ActiveSheet.Paste

Consider:
'Reposition COMMENTS Field from Column 7 to Column 13
ActiveSheet.Range("G:G").Cut
ActiveSheet.Range("M:M").Insert xlShiftToRight

This would copy G to the *current* column 13 (i.e., 13 *after* the removal
of G). Change to N:N if necessary.

--
HTH,
George

Damian Carrillo said:
I've been providing interim solutions for financial issues our full-
fledged developers do not have time to address. Some of the interim
solutions have a way of becoming defacto permanent solutions.

I'm always trying to find ways to build a better mousetrap but my code-
clean-up efforts have hit a wall. The first part of the following is
a snippet of code originally created by recording a macro.

The purpose of the code is to manipulate a data file from a vendor so
it is in a state that suits the end-user's needs (ie technophobic
comfort zone) so they can do an extensive amount of error checking and
data entry completion. One of the primary tasks is changing the order
in which the columns appear.

I find it hard to believe what I have devised is the only way to
manipulate columns of data. Surely there's a cleaner/more streamlined
way of accomplishing this functionality? I've made heavy use of
subroutine calls to shorten the amount of repetative code. I can also
post those modules if it would be helpful.


'Begin reformatting layout of travel bill reconcilliation from
Navagant
ActiveWindow.Zoom = 75
Sheets(1).Select
ActiveSheet.Columns("M:O").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(2).Select
ActiveSheet.Columns("H:I").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(1).Select

'Copies the column headers from the main sheet to the unmatched
sheet for debugging purposes only
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ResetRange

'Reposition COMMENTS Field from Column 7 to Column 13
ActiveSheet.Cells(2, 7).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 11).Select
ActiveSheet.Paste

'Reposition AMOUNT Field from Column 6 to Column 8
ActiveSheet.Cells(2, 6).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 8).Select
ActiveSheet.Paste

'Reposition DEPDATE Field from Column 3 to Column 7
ActiveSheet.Cells(2, 3).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 7).Select
ActiveSheet.Paste

'Reposition TICKET Field from Column 4 to Column 3
ActiveSheet.Cells(2, 4).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 3).Select
ActiveSheet.Paste

'Reposition AIRLINE Field from Column 5 to Column 4
ActiveSheet.Cells(2, 5).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 4).Select
ActiveSheet.Paste

'Copy Repositioned Data Block to Main Sheet
ActiveSheet.Rows("1:2").EntireRow.Select
Selection.Delete
ActiveSheet.Cells(1, 1).Select
ResetRange
SelectActiveArea
Selection.Cut
Sheets(1).Select
GotoStartOfRow
GotoBottom
GotoStartOfRow
MoveDown
Selection.Insert Shift:=xlDown
GotoStartOfRow
GotoBottom
MoveDown
MoveUp
ActiveCell.Select
LastRow = ActiveCell.Row

'Create Key Field for all records
Sheets(1).Cells(1, 13).Select
ActiveCell.FormulaR1C1 = "Key"
Sheets(1).Cells(2, 13).Select
AnalyzerFormula = "='AirTravelBill Assistant.xls'!
AnalyzeTravelBill(RC[-12],RC[-8],RC[-4],RC[-5],RC[-2],RC[-6],RC[-1],RC[-9])"
For Counter = 2 To LastRow
Cells(Counter, 13).FormulaR1C1 = AnalyzerFormula
Next Counter
GotoTop
ActiveCell.Select
Let Worksheets(1).Range("R1").Value = "2"

'Active AutoFilter and sort records by error type
Selection.AutoFilter
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort _
Key1:=ActiveSheet.Columns("M"), _
Order1:=xlDescending, _
Header:=xlYes
Range("A1:M1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium,
ColorIndex:=xlColorIndexAutomatic
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlMedium
.Borders(xlInsideVertical).ColorIndex = xlAutomatic
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
End With

With Workbooks("Travel.xls").Worksheets(1)
EnginesOnline
.Activate
.Range("A2").Select
ActiveWindow.FreezePanes = True
EnginesOffline
End With

ActiveCell.offset(-1, 0).Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.EntireRow.AutoFit
On Error Resume Next 'In case there are no Blanks
Columns("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange Key

Let Worksheets(1).Range("R1").Value = "3"
On Error GoTo 0 'Stop subroutine if unable to save file
ActiveWorkbook.Save 'Save new dataset
Windows("Travel.xls").Activate
EnginesOnline
'ActiveWindow.Close SaveChanges:=True 'Close source document
'Kill FilePath & "\TravelTemp.xls"
End Sub
 
D

Damian Carrillo

It appears you could use professional help but maybe this will make your
life a bit better.

Sub movecol()'whole column
Cells(1, 5).EntireColumn.Cut
Cells(1, 8).Insert
End Sub

Sub movecol1() 'rows 2:100
Range(Cells(2, 5), Cells(100, 5)).Cut
Cells(2, 8).Insert
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

I've been providing interim solutions for financial issues our full-
fledged developers do not have time to address. Some of the interim
solutions have a way of becoming defacto permanent solutions.
I'm always trying to find ways to build a better mousetrap but my code-
clean-up efforts have hit a wall. The first part of the following is
a snippet of code originally created by recording a macro.
The purpose of the code is to manipulate a data file from a vendor so
it is in a state that suits the end-user's needs (ie technophobic
comfort zone) so they can do an extensive amount of error checking and
data entry completion. One of the primary tasks is changing the order
in which the columns appear.
I find it hard to believe what I have devised is the only way to
manipulate columns of data. Surely there's a cleaner/more streamlined
way of accomplishing this functionality? I've made heavy use of
subroutine calls to shorten the amount of repetative code. I can also
post those modules if it would be helpful.
'Begin reformatting layout of travel bill reconcilliation from
Navagant
ActiveWindow.Zoom = 75
Sheets(1).Select
ActiveSheet.Columns("M:O").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(2).Select
ActiveSheet.Columns("H:I").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(1).Select
'Copies the column headers from the main sheet to the unmatched
sheet for debugging purposes only
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ResetRange
'Reposition COMMENTS Field from Column 7 to Column 13
ActiveSheet.Cells(2, 7).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 11).Select
ActiveSheet.Paste
'Reposition AMOUNT Field from Column 6 to Column 8
ActiveSheet.Cells(2, 6).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 8).Select
ActiveSheet.Paste
'Reposition DEPDATE Field from Column 3 to Column 7
ActiveSheet.Cells(2, 3).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 7).Select
ActiveSheet.Paste
'Reposition TICKET Field from Column 4 to Column 3
ActiveSheet.Cells(2, 4).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 3).Select
ActiveSheet.Paste
'Reposition AIRLINE Field from Column 5 to Column 4
ActiveSheet.Cells(2, 5).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 4).Select
ActiveSheet.Paste
'Copy Repositioned Data Block to Main Sheet
ActiveSheet.Rows("1:2").EntireRow.Select
Selection.Delete
ActiveSheet.Cells(1, 1).Select
ResetRange
SelectActiveArea
Selection.Cut
Sheets(1).Select
GotoStartOfRow
GotoBottom
GotoStartOfRow
MoveDown
Selection.Insert Shift:=xlDown
GotoStartOfRow
GotoBottom
MoveDown
MoveUp
ActiveCell.Select
LastRow = ActiveCell.Row
'Create Key Field for all records
Sheets(1).Cells(1, 13).Select
ActiveCell.FormulaR1C1 = "Key"
Sheets(1).Cells(2, 13).Select
AnalyzerFormula = "='AirTravelBill Assistant.xls'!
AnalyzeTravelBill(RC[-12],RC[-8],RC[-4],RC[-5],RC[-2],RC[-6],RC[-1],RC[-9])"
For Counter = 2 To LastRow
Cells(Counter, 13).FormulaR1C1 = AnalyzerFormula
Next Counter
GotoTop
ActiveCell.Select
Let Worksheets(1).Range("R1").Value = "2"
'Active AutoFilter and sort records by error type
Selection.AutoFilter
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort _
Key1:=ActiveSheet.Columns("M"), _
Order1:=xlDescending, _
Header:=xlYes
Range("A1:M1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium,
ColorIndex:=xlColorIndexAutomatic
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlMedium
.Borders(xlInsideVertical).ColorIndex = xlAutomatic
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
End With
With Workbooks("Travel.xls").Worksheets(1)
EnginesOnline
.Activate
.Range("A2").Select
ActiveWindow.FreezePanes = True
EnginesOffline
End With
ActiveCell.offset(-1, 0).Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.EntireRow.AutoFit
On Error Resume Next 'In case there are no Blanks
Columns("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange Key
Let Worksheets(1).Range("R1").Value = "3"
On Error GoTo 0 'Stop subroutine if unable to save file
ActiveWorkbook.Save 'Save new dataset
Windows("Travel.xls").Activate
EnginesOnline
'ActiveWindow.Close SaveChanges:=True 'Close source document
'Kill FilePath & "\TravelTemp.xls"
End Sub

Don,

If I understand your suggestion, this will basically become a
subroutine I can use by passing two variables (source column,
destination column), correct? The second one I'm a little hazier
on... I would love to be able to select specific sub-sections of
columns for moving or copying, however I'm not quite sure how I could
declare a range (100 wouldn't always be right) without expressly hard
coding the parameters.

Damian
 
D

Damian Carrillo

George,

Thank you for your input. What you suggested is exactly what I was
looking for in this situation. I'm going to give this a try and see
how it works.

Damian

Instead of:
'Reposition COMMENTS Field from Column 7 to Column 13
ActiveSheet.Cells(2, 7).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 11).Select
ActiveSheet.Paste

Consider:
'Reposition COMMENTS Field from Column 7 to Column 13
ActiveSheet.Range("G:G").Cut
ActiveSheet.Range("M:M").Insert xlShiftToRight

This would copy G to the *current* column 13 (i.e., 13 *after* the removal
of G). Change to N:N if necessary.

--
HTH,
George


I've been providing interim solutions for financial issues our full-
fledged developers do not have time to address. Some of the interim
solutions have a way of becoming defacto permanent solutions.
I'm always trying to find ways to build a better mousetrap but my code-
clean-up efforts have hit a wall. The first part of the following is
a snippet of code originally created by recording a macro.
The purpose of the code is to manipulate a data file from a vendor so
it is in a state that suits the end-user's needs (ie technophobic
comfort zone) so they can do an extensive amount of error checking and
data entry completion. One of the primary tasks is changing the order
in which the columns appear.
I find it hard to believe what I have devised is the only way to
manipulate columns of data. Surely there's a cleaner/more streamlined
way of accomplishing this functionality? I've made heavy use of
subroutine calls to shorten the amount of repetative code. I can also
post those modules if it would be helpful.
'Begin reformatting layout of travel bill reconcilliation from
Navagant
ActiveWindow.Zoom = 75
Sheets(1).Select
ActiveSheet.Columns("M:O").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(2).Select
ActiveSheet.Columns("H:I").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(1).Select
'Copies the column headers from the main sheet to the unmatched
sheet for debugging purposes only
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ResetRange
'Reposition COMMENTS Field from Column 7 to Column 13
ActiveSheet.Cells(2, 7).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 11).Select
ActiveSheet.Paste
'Reposition AMOUNT Field from Column 6 to Column 8
ActiveSheet.Cells(2, 6).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 8).Select
ActiveSheet.Paste
'Reposition DEPDATE Field from Column 3 to Column 7
ActiveSheet.Cells(2, 3).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 7).Select
ActiveSheet.Paste
'Reposition TICKET Field from Column 4 to Column 3
ActiveSheet.Cells(2, 4).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 3).Select
ActiveSheet.Paste
'Reposition AIRLINE Field from Column 5 to Column 4
ActiveSheet.Cells(2, 5).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 4).Select
ActiveSheet.Paste
'Copy Repositioned Data Block to Main Sheet
ActiveSheet.Rows("1:2").EntireRow.Select
Selection.Delete
ActiveSheet.Cells(1, 1).Select
ResetRange
SelectActiveArea
Selection.Cut
Sheets(1).Select
GotoStartOfRow
GotoBottom
GotoStartOfRow
MoveDown
Selection.Insert Shift:=xlDown
GotoStartOfRow
GotoBottom
MoveDown
MoveUp
ActiveCell.Select
LastRow = ActiveCell.Row
'Create Key Field for all records
Sheets(1).Cells(1, 13).Select
ActiveCell.FormulaR1C1 = "Key"
Sheets(1).Cells(2, 13).Select
AnalyzerFormula = "='AirTravelBill Assistant.xls'!
AnalyzeTravelBill(RC[-12],RC[-8],RC[-4],RC[-5],RC[-2],RC[-6],RC[-1],RC[-9])"
For Counter = 2 To LastRow
Cells(Counter, 13).FormulaR1C1 = AnalyzerFormula
Next Counter
GotoTop
ActiveCell.Select
Let Worksheets(1).Range("R1").Value = "2"
'Active AutoFilter and sort records by error type
Selection.AutoFilter
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort _
Key1:=ActiveSheet.Columns("M"), _
Order1:=xlDescending, _
Header:=xlYes
Range("A1:M1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium,
ColorIndex:=xlColorIndexAutomatic
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlMedium
.Borders(xlInsideVertical).ColorIndex = xlAutomatic
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
End With
With Workbooks("Travel.xls").Worksheets(1)
EnginesOnline
.Activate
.Range("A2").Select
ActiveWindow.FreezePanes = True
EnginesOffline
End With
ActiveCell.offset(-1, 0).Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.EntireRow.AutoFit
On Error Resume Next 'In case there are no Blanks
Columns("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange Key
Let Worksheets(1).Range("R1").Value = "3"
On Error GoTo 0 'Stop subroutine if unable to save file
ActiveWorkbook.Save 'Save new dataset
Windows("Travel.xls").Activate
EnginesOnline
'ActiveWindow.Close SaveChanges:=True 'Close source document
'Kill FilePath & "\TravelTemp.xls"
End Sub
 
D

Don Guillett

Pls TOP post. It's easier. The second assumed only that you did NOT want to
change row 1. First is better.



--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Damian Carrillo said:
It appears you could use professional help but maybe this will make your
life a bit better.

Sub movecol()'whole column
Cells(1, 5).EntireColumn.Cut
Cells(1, 8).Insert
End Sub

Sub movecol1() 'rows 2:100
Range(Cells(2, 5), Cells(100, 5)).Cut
Cells(2, 8).Insert
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
message

I've been providing interim solutions for financial issues our full-
fledged developers do not have time to address. Some of the interim
solutions have a way of becoming defacto permanent solutions.
I'm always trying to find ways to build a better mousetrap but my code-
clean-up efforts have hit a wall. The first part of the following is
a snippet of code originally created by recording a macro.
The purpose of the code is to manipulate a data file from a vendor so
it is in a state that suits the end-user's needs (ie technophobic
comfort zone) so they can do an extensive amount of error checking and
data entry completion. One of the primary tasks is changing the order
in which the columns appear.
I find it hard to believe what I have devised is the only way to
manipulate columns of data. Surely there's a cleaner/more streamlined
way of accomplishing this functionality? I've made heavy use of
subroutine calls to shorten the amount of repetative code. I can also
post those modules if it would be helpful.
'Begin reformatting layout of travel bill reconcilliation from
Navagant
ActiveWindow.Zoom = 75
Sheets(1).Select
ActiveSheet.Columns("M:O").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(2).Select
ActiveSheet.Columns("H:I").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
Sheets(1).Select
'Copies the column headers from the main sheet to the unmatched
sheet for debugging purposes only
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
ResetRange
'Reposition COMMENTS Field from Column 7 to Column 13
ActiveSheet.Cells(2, 7).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 11).Select
ActiveSheet.Paste
'Reposition AMOUNT Field from Column 6 to Column 8
ActiveSheet.Cells(2, 6).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 8).Select
ActiveSheet.Paste
'Reposition DEPDATE Field from Column 3 to Column 7
ActiveSheet.Cells(2, 3).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 7).Select
ActiveSheet.Paste
'Reposition TICKET Field from Column 4 to Column 3
ActiveSheet.Cells(2, 4).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 3).Select
ActiveSheet.Paste
'Reposition AIRLINE Field from Column 5 to Column 4
ActiveSheet.Cells(2, 5).Select
SelectToBottom
Selection.Cut
ActiveSheet.Cells(2, 4).Select
ActiveSheet.Paste
'Copy Repositioned Data Block to Main Sheet
ActiveSheet.Rows("1:2").EntireRow.Select
Selection.Delete
ActiveSheet.Cells(1, 1).Select
ResetRange
SelectActiveArea
Selection.Cut
Sheets(1).Select
GotoStartOfRow
GotoBottom
GotoStartOfRow
MoveDown
Selection.Insert Shift:=xlDown
GotoStartOfRow
GotoBottom
MoveDown
MoveUp
ActiveCell.Select
LastRow = ActiveCell.Row
'Create Key Field for all records
Sheets(1).Cells(1, 13).Select
ActiveCell.FormulaR1C1 = "Key"
Sheets(1).Cells(2, 13).Select
AnalyzerFormula = "='AirTravelBill Assistant.xls'!
AnalyzeTravelBill(RC[-12],RC[-8],RC[-4],RC[-5],RC[-2],RC[-6],RC[-1],RC[-9])"
For Counter = 2 To LastRow
Cells(Counter, 13).FormulaR1C1 = AnalyzerFormula
Next Counter
GotoTop
ActiveCell.Select
Let Worksheets(1).Range("R1").Value = "2"
'Active AutoFilter and sort records by error type
Selection.AutoFilter
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Sort _
Key1:=ActiveSheet.Columns("M"), _
Order1:=xlDescending, _
Header:=xlYes
Range("A1:M1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium,
ColorIndex:=xlColorIndexAutomatic
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlMedium
.Borders(xlInsideVertical).ColorIndex = xlAutomatic
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
End With
With Workbooks("Travel.xls").Worksheets(1)
EnginesOnline
.Activate
.Range("A2").Select
ActiveWindow.FreezePanes = True
EnginesOffline
End With
ActiveCell.offset(-1, 0).Range("A1").Select
ActiveCell.Rows("1:1").EntireRow.EntireRow.AutoFit
On Error Resume Next 'In case there are no Blanks
Columns("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange Key
Let Worksheets(1).Range("R1").Value = "3"
On Error GoTo 0 'Stop subroutine if unable to save file
ActiveWorkbook.Save 'Save new dataset
Windows("Travel.xls").Activate
EnginesOnline
'ActiveWindow.Close SaveChanges:=True 'Close source document
'Kill FilePath & "\TravelTemp.xls"
End Sub

Don,

If I understand your suggestion, this will basically become a
subroutine I can use by passing two variables (source column,
destination column), correct? The second one I'm a little hazier
on... I would love to be able to select specific sub-sections of
columns for moving or copying, however I'm not quite sure how I could
declare a range (100 wouldn't always be right) without expressly hard
coding the parameters.

Damian
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top