PC Review


Reply
Thread Tools Rate Thread

A Better Way to Reorganize Data?

 
 
Damian Carrillo
Guest
Posts: n/a
 
      21st Mar 2008
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
 
Reply With Quote
 
 
 
 
Don Guillett
Guest
Posts: n/a
 
      21st Mar 2008
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


 
Reply With Quote
 
George Nicholson
Guest
Posts: n/a
 
      21st Mar 2008
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



 
Reply With Quote
 
Damian Carrillo
Guest
Posts: n/a
 
      21st Mar 2008
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
 
Reply With Quote
 
Damian Carrillo
Guest
Posts: n/a
 
      21st Mar 2008
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


 
Reply With Quote
 
Don Guillett
Guest
Posts: n/a
 
      22nd Mar 2008
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


 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


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


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 03:20 AM.