Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
A Better Way to Reorganize Data?
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).Enti reRow.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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Need to reorganize data on a separate sheet possibly using vlookup | Excel Worksheet Functions | |||
macro; reorganize blocks of data | Excel Worksheet Functions | |||
macro; reorganize blocks of data | Excel Worksheet Functions | |||
Copy data from Workbook Alpha & reorganize it in Workbook Bravo | Excel Programming | |||
Reorganize Data | Excel Discussion (Misc queries) |