| Home | Forums | Reviews | Articles | Register |
![]() |
| Thread Tools | Rate Thread |
|
|
|
| |
|
Don Guillett
Guest
Posts: n/a
|
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 Removed) "Damian Carrillo" <(E-Mail Removed)> wrote in message news:75d2cac7-09d6-4887-ad6b-(E-Mail Removed)... > 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 |
|
||
|
||||
|
George Nicholson
Guest
Posts: n/a
|
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" <(E-Mail Removed)> wrote in message news:75d2cac7-09d6-4887-ad6b-(E-Mail Removed)... > 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 |
|
||
|
||||
|
Damian Carrillo
Guest
Posts: n/a
|
On Mar 21, 3:19 pm, "Don Guillett" <dguille...@austin.rr.com> 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 > dguille...@austin.rr.com"Damian Carrillo" <DamianM...@gmail.com> wrote in message > > news:75d2cac7-09d6-4887-ad6b-(E-Mail Removed)... > > > 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 |
|
||
|
||||
|
Damian Carrillo
Guest
Posts: n/a
|
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" <GeorgeNJ...@Junkmsn.com> 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" <DamianM...@gmail.com> wrote in message > > news:75d2cac7-09d6-4887-ad6b-(E-Mail Removed)... > > > 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 Guillett
Guest
Posts: n/a
|
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 Removed) "Damian Carrillo" <(E-Mail Removed)> wrote in message news:839cda94-8b83-49d0-b352-(E-Mail Removed)... > On Mar 21, 3:19 pm, "Don Guillett" <dguille...@austin.rr.com> 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 >> dguille...@austin.rr.com"Damian Carrillo" <DamianM...@gmail.com> wrote in >> message >> >> news:75d2cac7-09d6-4887-ad6b-(E-Mail Removed)... >> >> > 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 |
|
||
|
||||
|
|
|
| |
![]() |
| Thread Tools | |
| Rate This Thread | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Need to reorganize data on a separate sheet possibly using vlookup | Asa_johannesen | Microsoft Excel Worksheet Functions | 3 | 16th May 2008 10:37 PM |
| macro; reorganize blocks of data | anand | Microsoft Excel Worksheet Functions | 3 | 22nd Apr 2008 09:14 PM |
| macro; reorganize blocks of data | anand | Microsoft Excel Worksheet Functions | 1 | 22nd Apr 2008 04:17 PM |
| Copy data from Workbook Alpha & reorganize it in Workbook Bravo | u473 | Microsoft Excel Programming | 1 | 31st Oct 2007 02:37 AM |
| Reorganize Data | =?Utf-8?B?SkRW?= | Microsoft Excel Misc | 2 | 24th Jan 2007 11:20 AM |
Powered by vBulletin®. Copyright ©2000 - 2012, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2010, Crawlability, Inc. |




