Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Discussion (Misc queries) > Macro Problem
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 30
Default Macro Problem
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


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 1
Default Macro Problem

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 Wrote:
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.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

--------------------



--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: http://www.thecodecage.com/forumz/member.php?userid=1
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=91163

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

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

Similar Threads
Thread Thread Starter Forum Replies Last Post
Problem with Macro Kumar Excel Discussion (Misc queries) 7 April 21st 09 10:45 PM
I tried to get around the problem of the pivot table field settingdefaulting to Count instead of Sum by running a macro of change the settingfrom Count to Sum. However, when I tried to run the Macro, I got error messageof run time error 1004, unable Enda80 Excel Worksheet Functions 1 May 3rd 08 02:35 PM
I tried to get around the problem of the pivot table field settingdefaulting to Count instead of Sum by running a macro of change the settingfrom Count to Sum. However, when I tried to run the Macro, I got error messageof run time error 1004, unable Enda80 Excel Discussion (Misc queries) 1 May 3rd 08 10:52 AM
Macro problem [email protected][_2_] Excel Discussion (Misc queries) 2 March 4th 08 11:48 PM
Macro problem tweacle Excel Worksheet Functions 0 February 15th 06 08:26 PM


All times are GMT +1. The time now is 07:50 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement