Macro Problem

K

Kumar

I Have a Macro which contains some Costing Related Report... Now i got a
problem with the macro that for the next month that the data may vary and the
Macro doesn't work as the last column & Rows Differ ...So if any one can help
me to automatically select the Last column and Last row and there by apply
the Conditions specified in the Code... I will be Thankful if any one can
help me.... For reference i have uploaded my File in this Following Link:

Points to be Noted:
1) Remove the "cr" and Replace with "-"
2) Sum up all the Quarter(3months) and Keep the Formula without Paste Special
3) Subtotal the Data and insert the Serial no.
4) Color the "SubTotal" with Brown and Grand Total with "Blue"


http://www.easy-share.com/1904815745/Email.xls

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 28/04/2009 by Phani kumar
'

'
Range("A1:F559").Sort Key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range _
("B2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Selection.AutoFilter
Range("C1").Select
Selection.AutoFilter Field:=3, Criteria1:="=*cr*", Operator:=xlAnd
Range("C1").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToLeft).Select
Range("AK1").Select
ActiveCell.FormulaR1C1 = "-1"
Range("AK1").Select
Selection.Copy
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range("C64").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Replace What:="cr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Range("C1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Selection.AutoFilter
Range("D1").Select
Selection.AutoFilter Field:=4, Criteria1:="=*cr*", Operator:=xlAnd
Range("D154").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Replace What:="cr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("D1").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.Copy
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range("D154").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("D1").Select
Selection.AutoFilter
Selection.AutoFilter
Range("E1").Select
Selection.AutoFilter Field:=5, Criteria1:="=*cr*", Operator:=xlAnd
Range("E221").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Replace What:="cr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.End(xlUp).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.Copy
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range("E221").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("E1").Select
Selection.AutoFilter
Range("F1").Select
Selection.AutoFilter
Range("F1").Select
Selection.AutoFilter
Columns("C:C").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Replace What:="dr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("F1").Select
Selection.AutoFilter
Range("F1").Select
Selection.AutoFilter Field:=6, Criteria1:="=*cr*", Operator:=xlAnd
Range("F64").Select
Selection.Replace What:="cr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("F1").Select
Selection.End(xlToRight).Select
Selection.Copy
Selection.End(xlToLeft).Select
Range("F64").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("E1").Select
Selection.AutoFilter
Range("C1").Select
Selection.AutoFilter
Range("F1").Select
Selection.AutoFilter
Range("F2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F2").Select
Selection.Copy
Range("F2:F559").Select
Selection.SpecialCells(xlCellTypeVisible).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F1").Select
Selection.End(xlToLeft).Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4,
5, 6) _
, Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlUp)).Select
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Rows("3:823").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Selection.Font.ColorIndex = 9
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A3:A823").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Replace What:="Total", Replacement:="(Sub Total)", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:=False, _
ReplaceFormat:=False
ActiveSheet.Outline.ShowLevels RowLevels:=3
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
ActiveCell.FormulaR1C1 = "SI.NO"
Range("A1").Select
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range("B3:B823").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("E-Mail").Select
Sheets.Add
ActiveSheet.Paste
Selection.Columns.AutoFit
Range("B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range("B2").Select
ActiveCell.FormulaR1C1 = "2"
Range("B1:B2").Select
Selection.AutoFill Destination:=Range("B1:B264")
Range("B1:B264").Select
Sheets("E-Mail").Select
ActiveSheet.Outline.ShowLevels RowLevels:=3
Range("A2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(C[1],Sheet1!C:C[1],2,FALSE)"
Range("A2").Select
Selection.Copy
Range("B2").Select
Selection.End(xlDown).Select
Range("A823").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Range("A822:A823").Select
Range("A823").Activate
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:A").Select
Range("A823").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A822").Select
Selection.Copy
Columns("A:A").Select
Range("A822").Activate
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Selection.Font.ColorIndex = 9
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A810").Select
Selection.End(xlUp).Select
Range("B807").Select
Selection.End(xlUp).Select
Range("B1").Select
Selection.Copy
Range("A1:B1").Select
Range("B1").Activate
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveSheet.Outline.ShowLevels RowLevels:=1
Rows("824:824").Select
Selection.Font.ColorIndex = 5
Selection.Font.Bold = False
Selection.Font.Bold = True
ActiveSheet.Outline.ShowLevels RowLevels:=3
Range("A1").Select
End Sub
 
S

Simon Lloyd

Before we can help really you need to tidy up that code, there are lots
and lots of lines that do nothing, you also do not need all those
selects they only serve to slow Excel down, you don't need to select an
object in order to manipulate it, take a look at this part of your code
Code:
--------------------
Range("C1").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToLeft).Select
Range("AK1").Select
ActiveCell.FormulaR1C1 = "-1"
Range("AK1").Select
Selection.Copy
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
--------------------
that could be boiled down to
Code:
--------------------

Range("AK1").FormulaR1C1 = "-1"

--------------------
As you do not copy anything!, and instead of Range("A1").Select then
Range(Selection.....etc you would be better of using
Code:
--------------------
With Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
.Replace What:="cr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
--------------------
Getting rid of yet more selections, try portioning off your code and
seeing how you can make it more efficient.

Kumar;326250 said:
I Have a Macro which contains some Costing Related Report... Now i got a
problem with the macro that for the next month that the data may vary
and the
Macro doesn't work as the last column & Rows Differ ...So if any one
can help
me to automatically select the Last column and Last row and there by
apply
the Conditions specified in the Code... I will be Thankful if any one
can
help me.... For reference i have uploaded my File in this Following
Link:

Points to be Noted:
1) Remove the "cr" and Replace with "-"
2) Sum up all the Quarter(3months) and Keep the Formula without Paste
Special
3) Subtotal the Data and insert the Serial no.
4) Color the "SubTotal" with Brown and Grand Total with "Blue"


'Download Email.xls, upload your files and earn money.'
(http://www.easy-share.com/1904815745/Email.xls)
Code:
--------------------Sub Macro1()
'
' Macro1 Macro
' Macro recorded 28/04/2009 by Phani kumar
'

'
Range("A1:F559").Sort Key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range _
("B2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
Selection.AutoFilter
Range("C1").Select
Selection.AutoFilter Field:=3, Criteria1:="=*cr*", Operator:=xlAnd
Range("C1").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToLeft).Select
Range("AK1").Select
ActiveCell.FormulaR1C1 = "-1"
Range("AK1").Select
Selection.Copy
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range("C64").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Replace What:="cr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Range("C1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Selection.AutoFilter
Range("D1").Select
Selection.AutoFilter Field:=4, Criteria1:="=*cr*", Operator:=xlAnd
Range("D154").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Replace What:="cr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("D1").Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.Copy
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range("D154").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("D1").Select
Selection.AutoFilter
Selection.AutoFilter
Range("E1").Select
Selection.AutoFilter Field:=5, Criteria1:="=*cr*", Operator:=xlAnd
Range("E221").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Replace What:="cr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.End(xlUp).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.Copy
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Range("E221").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("E1").Select
Selection.AutoFilter
Range("F1").Select
Selection.AutoFilter
Range("F1").Select
Selection.AutoFilter
Columns("C:C").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Replace What:="dr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("F1").Select
Selection.AutoFilter
Range("F1").Select
Selection.AutoFilter Field:=6, Criteria1:="=*cr*", Operator:=xlAnd
Range("F64").Select
Selection.Replace What:="cr", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("F1").Select
Selection.End(xlToRight).Select
Selection.Copy
Selection.End(xlToLeft).Select
Range("F64").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("E1").Select
Selection.AutoFilter
Range("C1").Select
Selection.AutoFilter
Range("F1").Select
Selection.AutoFilter
Range("F2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
Range("F2").Select
Selection.Copy
Range("F2:F559").Select
Selection.SpecialCells(xlCellTypeVisible).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("F1").Select
Selection.End(xlToLeft).Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4,
5, 6) _
, Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlUp)).Select
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Rows("3:823").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Selection.Font.ColorIndex = 9
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A3:A823").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Replace What:="Total", Replacement:="(Sub Total)", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:=False, _
ReplaceFormat:=False
ActiveSheet.Outline.ShowLevels RowLevels:=3
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
ActiveCell.FormulaR1C1 = "SI.NO"
Range("A1").Select
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range("B3:B823").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("E-Mail").Select
Sheets.Add
ActiveSheet.Paste
Selection.Columns.utoFit
Range("B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range("B2").Select
ActiveCell.FormulaR1C1 = "2"
Range("B1:B2").Select
Selection.AutoFill Destination:=Range("B1:B264")
Range("B1:B264").Select
Sheets("E-Mail").Select
ActiveSheet.Outline.ShowLevels RowLevels:=3
Range("A2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(C[1],Sheet1!C:C[1],2,FALSE)"
Range("A2").Select
Selection.Copy
Range("B2").Select
Selection.End(xlDown).Select
Range("A823").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Range("A822:A823").Select
Range("A823").Activate
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:A").Select
Range("A823").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A822").Select
Selection.Copy
Columns("A:A").Select
Range("A822").Activate
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Selection.Font.ColorIndex = 9
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A810").Select
Selection.End(xlUp).Select
Range("B807").Select
Selection.End(xlUp).Select
Range("B1").Select
Selection.Copy
Range("A1:B1").Select
Range("B1").Activate
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveSheet.Outline.ShowLevels RowLevels:=1
Rows("824:824").Select
Selection.Font.ColorIndex = 5
Selection.Font.Bold = False
Selection.Font.Bold = True
ActiveSheet.Outline.ShowLevels RowLevels:=3
Range("A1").Select
End Sub
--------------------
Click to expand...


--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro for Costing 0
Problem with Macro 7
Macro - very slow run in 2003 3
Macro to copy/paste from one workbook to another 8
macro problem: range offset question 6
Getting a Cell Value into a Macro! 2
Macro to sort variable data range fails 1
I need help with a macro please! 5

Top