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
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