| 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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
A Better Way to Reorganize Data?
|
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
A Better Way to Reorganize Data?
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" wrote in 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).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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
A Better Way to Reorganize Data?
On Mar 21, 3:19 pm, "Don Guillett" wrote:
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 "Damian Carrillo" wrote in 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).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 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 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
A Better Way to Reorganize Data?
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 On Mar 21, 3:26 pm, "George Nicholson" wrote: 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" wrote in 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).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 |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
A Better Way to Reorganize Data?
|
| Reply |
| 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) | |||
![Damian Carrillo[_3_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Linear Mode
