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