| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Problem with Macro
I Have a Macro which was not totaling as per my criteria, i wanna To Display
the amount to the respective account and Sum up the Values of expenses... This is my Macro : Columns("A:A").EntireColumn.Select Selection.Delete Shift:=xlToLeft Range("A1").Select Selection.Rows("1:6").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Selection.End(xlUp).Select Cells.Find(What:="cash inflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Range("A1").Select Cells.Find(What:="cash outflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Columns("A:A").EntireColumn.Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Replace What:="account", Replacement:="Particulars", LookAt:=xlPart _ , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="Details", Replacement:="Amount", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Find(What:="b/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown Selection.Insert Shift:=xlDown ActiveCell.Rows("1:2").EntireRow.Select Selection.Interior.ColorIndex = xlNone Selection.Font.ColorIndex = 0 ActiveCell.Select ActiveCell.FormulaR1C1 = "RECEIPTS" ActiveCell.Offset(1, 0).Range("A1").Select ActiveCell.FormulaR1C1 = "OPENING BALANCE" Cells.Find(What:="receipts", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow.Select ActiveCell.Activate Selection.Interior.ColorIndex = xlNone Selection.Font.ColorIndex = 0 Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "(Rs.)" ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "(Rs.)" ActiveCell.Select Selection.End(xlUp).Select ActiveCell.Rows("1:1").EntireRow.Select ActiveCell.Activate Selection.Insert Shift:=xlDown Range("A1").Select ActiveCell.FormulaR1C1 = "MIS REPORT FOR THE PERIOD OF" ActiveCell.Range("A1:C1").Select ActiveWindow.SmallScroll Down:=-3 With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Selection.Font.Bold = True ActiveCell.Offset(5, 0).Range("A1:C2").Select Selection.Font.Bold = True ActiveCell.Offset(-5, 0).Range("A1:C1").Select Cells.Find(What:="income", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate ActiveCell.Range("A1:C1").Select Selection.Font.Bold = True Selection.End(xlToLeft).Select Selection.End(xlUp).Select Cells.Find(What:="total (Rupees)", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Range(Selection, Selection.End(xlToRight)).Select Selection.Font.Bold = True Selection.End(xlToRight).Select Range(Selection, Selection.End(xlToLeft)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Selection.Replace What:="cr", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select Cells.Find(What:="total (Rupees)", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Offset(0, 2).Range("A1").Select ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)" Cells.Find(What:="expenses", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown ActiveCell.Offset(1, 0).Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Replace What:="dr", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveWindow.ScrollRow = 13 ActiveWindow.ScrollRow = 12 ActiveWindow.ScrollRow = 11 ActiveWindow.ScrollRow = 10 ActiveWindow.ScrollRow = 9 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 7 ActiveWindow.ScrollRow = 6 ActiveWindow.ScrollRow = 5 ActiveWindow.ScrollRow = 4 ActiveWindow.ScrollRow = 3 ActiveWindow.ScrollRow = 2 ActiveWindow.ScrollRow = 1 ActiveCell.Offset(-11, 0).Range("A1:C1").Select Cells.Find(What:="expenses", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select ActiveCell.Offset(0, 2).Range("A1").Activate Selection.AutoFilter ActiveCell.Offset(0, -2).Range("A1").Select Selection.AutoFilter Field:=1, Criteria1:="=" ActiveCell.Offset(4, 2).Range("A1").Select ActiveCell.FormulaR1C1 = "=RC[-1]" ActiveCell.Select Selection.Copy ActiveCell.Range("A1:A28").Select Selection.SpecialCells(xlCellTypeVisible).Select ActiveSheet.Paste Application.CutCopyMode = False ActiveCell.Offset(-4, -2).Range("A1").Select Selection.AutoFilter ActiveCell.Rows("1:1").EntireRow.Select Selection.AutoFilter ActiveCell.Select Selection.AutoFilter Field:=1, Criteria1:="=" Selection.AutoFilter ActiveCell.Range("A1:C1").Select ActiveCell.Offset(0, 2).Range("A1").Activate Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A1").Select Cells.Find(What:="expenses", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.AutoFilter ActiveCell.Select Selection.AutoFilter Field:=1, Criteria1:="=" ActiveCell.Offset(4, 1).Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.ClearContents ActiveCell.Offset(-4, 0).Range("A1").Select Selection.AutoFilter ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "=SUM(R[1]C[-1]:R[30]C[-1])" ActiveCell.Offset(1, 0).Range("A1").Select ActiveWindow.SmallScroll Down:=-6 Range("A1").Select ActiveWindow.SmallScroll Down:=3 Cells.Find(What:="c/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate Range(Selection, Selection.End(xlToRight)).Select Selection.Font.Bold = True ActiveCell.Select Cells.Find(What:="total (Rupees)", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Range(Selection, Selection.End(xlToRight)).Select Selection.Font.Bold = True Selection.End(xlToRight).Select ActiveCell.FormulaR1C1 = "=SUM(R[-1]C,R[-33]C)" ActiveCell.Offset(0, -2).Range("A1:C1").Select ActiveCell.Activate Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Range(Selection, Selection.End(xlUp)).Select Range("A1:B44").Select Selection.NumberFormat = "0.00" Range("A1:A42").Select ActiveCell.Activate Selection.Font.Bold = False Selection.Font.Bold = True Selection.End(xlUp).Select Cells.Find(What:="c/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate Range("A1").Select Cells.Find(What:="c/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown ActiveCell.Select ActiveCell.FormulaR1C1 = "CLOSING BALANCE" ActiveCell.Select Selection.Font.Bold = True ActiveWindow.SmallScroll Down:=-45 Range("A1:C1").Select Cells.Find(What:="expenses", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.FormulaR1C1 = "PAYMENTS" ActiveCell.Select End Sub If any one can Help me I will be Greatly Helpful |
|
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Problem with Macro
I don't recommend using recorded macros without editing the code. Especially
when you end up with a macro this big. When using FIND set a variable to the location so it is easier to code. I fixed your total as best as I could. It looks like you are trying to add all the values in a table. I think the table size may be veariable but your could was using a fixed size table of 23 rows. Also fixed this problem. I can't guarantee this code will work becaue of the large number of changes that were made. If yo need more help let me know. Sub Macro1() Columns("A:A").Delete Rows("1:8").Delete Set c = Cells.Find(What:="cash inflow", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Set c = Cells.Find(What:="cash outflow", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Columns("A").EntireColumn.Replace _ What:=" ", _ Replacement:="", _ LookAt:=xlPart Cells.Replace _ What:="account", _ Replacement:="Particulars", _ LookAt:=xlPart Cells.Replace _ What:="Details", _ Replacement:="Amount", _ LookAt:=xlPart Set c = Cells.Find(What:="b/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("1:2").EntireRow.Insert End If With Rows("1:2") .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 End With Range("A1") = "RECEIPTS" Range("B1") = "OPENING BALANCE" Set c = Cells.Find(What:="receipts", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete With c.Offset(-1, 0).Rows("1:2").EntireRow .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With c.Offset(0, 1) = "(Rs.)" c.Offset(0, 2) = "(Rs.)" End If Rows(1).Insert Range("A1") = "MIS REPORT FOR THE PERIOD OF" With Range("A1:C1") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .Merge .Font.Bold = True End With Range("A6:C7").Font.Bold = True Set c = Cells.Find(What:="income", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.Range("A1:C1").Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True Set ReplaceRange = Range(c, c.End(xlUp)) ReplaceRange.Replace _ What:="cr", _ Replacement:="", _ LookAt:=xlPart c.Offset(0, 2).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)" End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Insert Set c = c.Offset(1, 0) Set LastCol = c.End(xlToRight) Set LastCell = LastCol.End(xlDown) LastRow = LastCell.Row Set ReplaceRange = Range(c, LastCell) ReplaceRange.Replace _ What:="dr", _ Replacement:="", _ LookAt:=xlPart Set FilterColumn = c.Offset(0, 2) FilterColumn.AutoFilter FilterColumn.AutoFilter Field:=1, Criteria1:="=" Set FirstFormula = c.Offset(4, 2) Set LastFormula = Cells(LastRow, FirstFormula.Column) Set PasteRange = Range(FirstFormula, LastFormula) Set VisibleRange = PasteRange.SpecialCells(xlCellTypeVisible) FirstFormula.Offset(4, 2).FormulaR1C1 = "=RC[-1]" FirstFormula.Copy VisibleRange.PasteSpecial _ Paste:=xlPasteValues Set FormulaRange = Range(c.Offset(0, 1), _ Cells(LastRow, c.Offset(0, 1).Column)) FormulaRange.clearcontnets FormulaRange.FormulaR1C1 = "=SUM(R[1]C[-1]:R[30]C[-1])" End If Set c = Cells.Find(What:="c/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then LastCol = c.End(xlToRight) Range(c, LastCol).Font.Bold = True Set LastFormula = c.End(xlToRight).ofset(-1, 0) Set FirstFormula = LastFormula.End(xlUp) LastCol.Formula = _ "=SUM(" & FirstFormula.Address & ":" & LastFormula.Address & ")" With c.Range("A1:C1") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With End If Range("A1:B44").NumberFormat = "0.00" With Range("A1:A42") .Font.Bold = False .Font.Bold = True End With Set c = Cells.Find(What:="c/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows(1).Insert c.FormulaR1C1 = "CLOSING BALANCE" c.Font.Bold = True End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.FormulaR1C1 = "PAYMENTS" c.Select End If End Sub "Kumar" wrote: I Have a Macro which was not totaling as per my criteria, i wanna To Display the amount to the respective account and Sum up the Values of expenses... This is my Macro : Columns("A:A").EntireColumn.Select Selection.Delete Shift:=xlToLeft Range("A1").Select Selection.Rows("1:6").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Selection.End(xlUp).Select Cells.Find(What:="cash inflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Range("A1").Select Cells.Find(What:="cash outflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Columns("A:A").EntireColumn.Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Replace What:="account", Replacement:="Particulars", LookAt:=xlPart _ , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="Details", Replacement:="Amount", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Find(What:="b/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown Selection.Insert Shift:=xlDown ActiveCell.Rows("1:2").EntireRow.Select Selection.Interior.ColorIndex = xlNone Selection.Font.ColorIndex = 0 ActiveCell.Select ActiveCell.FormulaR1C1 = "RECEIPTS" ActiveCell.Offset(1, 0).Range("A1").Select ActiveCell.FormulaR1C1 = "OPENING BALANCE" Cells.Find(What:="receipts", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow.Select ActiveCell.Activate Selection.Interior.ColorIndex = xlNone Selection.Font.ColorIndex = 0 Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "(Rs.)" ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "(Rs.)" ActiveCell.Select Selection.End(xlUp).Select ActiveCell.Rows("1:1").EntireRow.Select ActiveCell.Activate Selection.Insert Shift:=xlDown Range("A1").Select ActiveCell.FormulaR1C1 = "MIS REPORT FOR THE PERIOD OF" ActiveCell.Range("A1:C1").Select ActiveWindow.SmallScroll Down:=-3 With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Selection.Font.Bold = True ActiveCell.Offset(5, 0).Range("A1:C2").Select Selection.Font.Bold = True ActiveCell.Offset(-5, 0).Range("A1:C1").Select Cells.Find(What:="income", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Activate ActiveCell.Range("A1:C1").Select Selection.Font.Bold = True Selection.End(xlToLeft).Select Selection.End(xlUp).Select Cells.Find(What:="total (Rupees)", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Range(Selection, Selection.End(xlToRight)).Select Selection.Font.Bold = True Selection.End(xlToRight).Select Range(Selection, Selection.End(xlToLeft)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Selection.Replace What:="cr", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select Cells.Find(What:="total (Rupees)", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Offset(0, 2).Range("A1").Select ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)" Cells.Find(What:="expenses", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown ActiveCell.Offset(1, 0).Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Replace What:="dr", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveWindow.ScrollRow = 13 ActiveWindow.ScrollRow = 12 ActiveWindow.ScrollRow = 11 ActiveWindow.ScrollRow = 10 ActiveWindow.ScrollRow = 9 ActiveWindow.ScrollRow = 8 ActiveWindow.ScrollRow = 7 ActiveWindow.ScrollRow = 6 ActiveWindow.ScrollRow = 5 ActiveWindow.ScrollRow = 4 ActiveWindow.ScrollRow = 3 ActiveWindow.ScrollRow = 2 ActiveWindow.ScrollRow = 1 ActiveCell.Offset(-11, 0).Range("A1:C1").Select Cells.Find(What:="expenses", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select ActiveCell.Offset(0, 2).Range("A1").Activate Selection.AutoFilter ActiveCell.Offset(0, -2).Range("A1").Select Selection.AutoFilter Field:=1, Criteria1:="=" ActiveCell.Offset(4, 2).Range("A1").Select ActiveCell.FormulaR1C1 = "=RC[-1]" ActiveCell.Select Selection.Copy ActiveCell.Range("A1:A28").Select Selection.SpecialCells(xlCellTypeVisible).Select ActiveSheet.Paste Application.CutCopyMode = False ActiveCell.Offset(-4, -2).Range("A1").Select Selection.AutoFilter ActiveCell.Rows("1:1").EntireRow.Select Selection.AutoFilter ActiveCell.Select Selection.AutoFilter Field:=1, Criteria1:="=" Selection.AutoFilter ActiveCell.Range("A1:C1").Select ActiveCell.Offset(0, 2).Range("A1").Activate Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A1").Select Cells.Find(What:="expenses", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.AutoFilter ActiveCell.Select Selection.AutoFilter Field:=1, Criteria1:="=" ActiveCell.Offset(4, 1).Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.ClearContents ActiveCell.Offset(-4, 0).Range("A1").Select Selection.AutoFilter ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "=SUM(R[1]C[-1]:R[30]C[-1])" ActiveCell.Offset(1, 0).Range("A1").Select ActiveWindow.SmallScroll Down:=-6 Range("A1").Select ActiveWindow.SmallScroll Down:=3 Cells.Find(What:="c/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate Range(Selection, Selection.End(xlToRight)).Select Selection.Font.Bold = True ActiveCell.Select Cells.Find(What:="total (Rupees)", After:=ActiveCell, LookIn:=xlFormulas _ , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate Range(Selection, Selection.End(xlToRight)).Select Selection.Font.Bold = True Selection.End(xlToRight).Select ActiveCell.FormulaR1C1 = "=SUM(R[-1]C,R[-33]C)" ActiveCell.Offset(0, -2).Range("A1:C1").Select ActiveCell.Activate Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Range(Selection, Selection.End(xlUp)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Range(Selection, Selection.End(xlUp)).Select Range("A1:B44").Select Selection.NumberFormat = "0.00" Range("A1:A42").Select ActiveCell.Activate Selection.Font.Bold = False Selection.Font.Bold = True Selection.End(xlUp).Select Cells.Find(What:="c/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate Range("A1").Select Cells.Find(What:="c/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown ActiveCell.Select ActiveCell.FormulaR1C1 = "CLOSING BALANCE" ActiveCell.Select Selection.Font.Bold = True ActiveWindow.SmallScroll Down:=-45 Range("A1:C1").Select Cells.Find(What:="expenses", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.FormulaR1C1 = "PAYMENTS" ActiveCell.Select End Sub If any one can Help me I will be Greatly Helpful |
|
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Problem with Macro
Hey Joel Thanks for the Response but ....there was a Error in the Code it
stops at the Line Set VisibleRange = PasteRange.SpecialCells(xlCellTypeVisible) I Think there was some problem paste special visiblity range... As i was new to macro i don't know the exact reason... If any one can help it would be Greatly Helpful... "joel" wrote: I don't recommend using recorded macros without editing the code. Especially when you end up with a macro this big. When using FIND set a variable to the location so it is easier to code. I fixed your total as best as I could. It looks like you are trying to add all the values in a table. I think the table size may be veariable but your could was using a fixed size table of 23 rows. Also fixed this problem. I can't guarantee this code will work becaue of the large number of changes that were made. If yo need more help let me know. Sub Macro1() Columns("A:A").Delete Rows("1:8").Delete Set c = Cells.Find(What:="cash inflow", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Set c = Cells.Find(What:="cash outflow", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Columns("A").EntireColumn.Replace _ What:=" ", _ Replacement:="", _ LookAt:=xlPart Cells.Replace _ What:="account", _ Replacement:="Particulars", _ LookAt:=xlPart Cells.Replace _ What:="Details", _ Replacement:="Amount", _ LookAt:=xlPart Set c = Cells.Find(What:="b/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("1:2").EntireRow.Insert End If With Rows("1:2") .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 End With Range("A1") = "RECEIPTS" Range("B1") = "OPENING BALANCE" Set c = Cells.Find(What:="receipts", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete With c.Offset(-1, 0).Rows("1:2").EntireRow .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With c.Offset(0, 1) = "(Rs.)" c.Offset(0, 2) = "(Rs.)" End If Rows(1).Insert Range("A1") = "MIS REPORT FOR THE PERIOD OF" With Range("A1:C1") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .Merge .Font.Bold = True End With Range("A6:C7").Font.Bold = True Set c = Cells.Find(What:="income", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.Range("A1:C1").Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True Set ReplaceRange = Range(c, c.End(xlUp)) ReplaceRange.Replace _ What:="cr", _ Replacement:="", _ LookAt:=xlPart c.Offset(0, 2).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)" End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Insert Set c = c.Offset(1, 0) Set LastCol = c.End(xlToRight) Set LastCell = LastCol.End(xlDown) LastRow = LastCell.Row Set ReplaceRange = Range(c, LastCell) ReplaceRange.Replace _ What:="dr", _ Replacement:="", _ LookAt:=xlPart Set FilterColumn = c.Offset(0, 2) FilterColumn.AutoFilter FilterColumn.AutoFilter Field:=1, Criteria1:="=" Set FirstFormula = c.Offset(4, 2) Set LastFormula = Cells(LastRow, FirstFormula.Column) Set PasteRange = Range(FirstFormula, LastFormula) Set VisibleRange = PasteRange.SpecialCells(xlCellTypeVisible) FirstFormula.Offset(4, 2).FormulaR1C1 = "=RC[-1]" FirstFormula.Copy VisibleRange.PasteSpecial _ Paste:=xlPasteValues Set FormulaRange = Range(c.Offset(0, 1), _ Cells(LastRow, c.Offset(0, 1).Column)) FormulaRange.clearcontnets FormulaRange.FormulaR1C1 = "=SUM(R[1]C[-1]:R[30]C[-1])" End If Set c = Cells.Find(What:="c/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then LastCol = c.End(xlToRight) Range(c, LastCol).Font.Bold = True Set LastFormula = c.End(xlToRight).ofset(-1, 0) Set FirstFormula = LastFormula.End(xlUp) LastCol.Formula = _ "=SUM(" & FirstFormula.Address & ":" & LastFormula.Address & ")" With c.Range("A1:C1") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With End If Range("A1:B44").NumberFormat = "0.00" With Range("A1:A42") .Font.Bold = False .Font.Bold = True End With Set c = Cells.Find(What:="c/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows(1).Insert c.FormulaR1C1 = "CLOSING BALANCE" c.Font.Bold = True End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.FormulaR1C1 = "PAYMENTS" c.Select End If End Sub "Kumar" wrote: I Have a Macro which was not totaling as per my criteria, i wanna To Display the amount to the respective account and Sum up the Values of expenses... This is my Macro : Columns("A:A").EntireColumn.Select Selection.Delete Shift:=xlToLeft Range("A1").Select Selection.Rows("1:6").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Selection.End(xlUp).Select Cells.Find(What:="cash inflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Range("A1").Select Cells.Find(What:="cash outflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Columns("A:A").EntireColumn.Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Replace What:="account", Replacement:="Particulars", LookAt:=xlPart _ , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="Details", Replacement:="Amount", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Find(What:="b/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown Selection.Insert Shift:=xlDown ActiveCell.Rows("1:2").EntireRow.Select Selection.Interior.ColorIndex = xlNone |
|
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Problem with Macro
Hey Joel You can Find my File at the Following Link:
http://www.easy-share.com/1904615394/Consolidated Cash flow.xls Pls Help me in this Regard.... "joel" wrote: I don't recommend using recorded macros without editing the code. Especially when you end up with a macro this big. When using FIND set a variable to the location so it is easier to code. I fixed your total as best as I could. It looks like you are trying to add all the values in a table. I think the table size may be veariable but your could was using a fixed size table of 23 rows. Also fixed this problem. I can't guarantee this code will work becaue of the large number of changes that were made. If yo need more help let me know. Sub Macro1() Columns("A:A").Delete Rows("1:8").Delete Set c = Cells.Find(What:="cash inflow", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Set c = Cells.Find(What:="cash outflow", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Columns("A").EntireColumn.Replace _ What:=" ", _ Replacement:="", _ LookAt:=xlPart Cells.Replace _ What:="account", _ Replacement:="Particulars", _ LookAt:=xlPart Cells.Replace _ What:="Details", _ Replacement:="Amount", _ LookAt:=xlPart Set c = Cells.Find(What:="b/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("1:2").EntireRow.Insert End If With Rows("1:2") .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 End With Range("A1") = "RECEIPTS" Range("B1") = "OPENING BALANCE" Set c = Cells.Find(What:="receipts", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete With c.Offset(-1, 0).Rows("1:2").EntireRow .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With c.Offset(0, 1) = "(Rs.)" c.Offset(0, 2) = "(Rs.)" End If Rows(1).Insert Range("A1") = "MIS REPORT FOR THE PERIOD OF" With Range("A1:C1") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .Merge .Font.Bold = True End With Range("A6:C7").Font.Bold = True Set c = Cells.Find(What:="income", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.Range("A1:C1").Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True Set ReplaceRange = Range(c, c.End(xlUp)) ReplaceRange.Replace _ What:="cr", _ Replacement:="", _ LookAt:=xlPart c.Offset(0, 2).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)" End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Insert Set c = c.Offset(1, 0) Set LastCol = c.End(xlToRight) Set LastCell = LastCol.End(xlDown) LastRow = LastCell.Row Set ReplaceRange = Range(c, LastCell) ReplaceRange.Replace _ What:="dr", _ Replacement:="", _ LookAt:=xlPart Set FilterColumn = c.Offset(0, 2) FilterColumn.AutoFilter FilterColumn.AutoFilter Field:=1, Criteria1:="=" Set FirstFormula = c.Offset(4, 2) Set LastFormula = Cells(LastRow, FirstFormula.Column) Set PasteRange = Range(FirstFormula, LastFormula) Set VisibleRange = PasteRange.SpecialCells(xlCellTypeVisible) FirstFormula.Offset(4, 2).FormulaR1C1 = "=RC[-1]" FirstFormula.Copy VisibleRange.PasteSpecial _ Paste:=xlPasteValues Set FormulaRange = Range(c.Offset(0, 1), _ Cells(LastRow, c.Offset(0, 1).Column)) FormulaRange.clearcontnets FormulaRange.FormulaR1C1 = "=SUM(R[1]C[-1]:R[30]C[-1])" End If Set c = Cells.Find(What:="c/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then LastCol = c.End(xlToRight) Range(c, LastCol).Font.Bold = True Set LastFormula = c.End(xlToRight).ofset(-1, 0) Set FirstFormula = LastFormula.End(xlUp) LastCol.Formula = _ "=SUM(" & FirstFormula.Address & ":" & LastFormula.Address & ")" With c.Range("A1:C1") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With End If Range("A1:B44").NumberFormat = "0.00" With Range("A1:A42") .Font.Bold = False .Font.Bold = True End With Set c = Cells.Find(What:="c/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows(1).Insert c.FormulaR1C1 = "CLOSING BALANCE" c.Font.Bold = True End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.FormulaR1C1 = "PAYMENTS" c.Select End If End Sub "Kumar" wrote: I Have a Macro which was not totaling as per my criteria, i wanna To Display the amount to the respective account and Sum up the Values of expenses... This is my Macro : Columns("A:A").EntireColumn.Select Selection.Delete Shift:=xlToLeft Range("A1").Select Selection.Rows("1:6").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Selection.End(xlUp).Select Cells.Find(What:="cash inflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Range("A1").Select Cells.Find(What:="cash outflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Columns("A:A").EntireColumn.Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Replace What:="account", Replacement:="Particulars", LookAt:=xlPart _ , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="Details", Replacement:="Amount", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Find(What:="b/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Insert Shift:=xlDown Selection.Insert Shift:=xlDown ActiveCell.Rows("1:2").EntireRow.Select Selection.Interior.ColorIndex = xlNone |
|
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Problem with Macro
I wasn't able to download the file. It looks like the file size is zero
bytes. I'm also not getting an error with the code I posted. "Kumar" wrote: Hey Joel You can Find my File at the Following Link: http://www.easy-share.com/1904615394/Consolidated Cash flow.xls Pls Help me in this Regard.... "joel" wrote: I don't recommend using recorded macros without editing the code. Especially when you end up with a macro this big. When using FIND set a variable to the location so it is easier to code. I fixed your total as best as I could. It looks like you are trying to add all the values in a table. I think the table size may be veariable but your could was using a fixed size table of 23 rows. Also fixed this problem. I can't guarantee this code will work becaue of the large number of changes that were made. If yo need more help let me know. Sub Macro1() Columns("A:A").Delete Rows("1:8").Delete Set c = Cells.Find(What:="cash inflow", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Set c = Cells.Find(What:="cash outflow", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Columns("A").EntireColumn.Replace _ What:=" ", _ Replacement:="", _ LookAt:=xlPart Cells.Replace _ What:="account", _ Replacement:="Particulars", _ LookAt:=xlPart Cells.Replace _ What:="Details", _ Replacement:="Amount", _ LookAt:=xlPart Set c = Cells.Find(What:="b/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("1:2").EntireRow.Insert End If With Rows("1:2") .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 End With Range("A1") = "RECEIPTS" Range("B1") = "OPENING BALANCE" Set c = Cells.Find(What:="receipts", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete With c.Offset(-1, 0).Rows("1:2").EntireRow .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With c.Offset(0, 1) = "(Rs.)" c.Offset(0, 2) = "(Rs.)" End If Rows(1).Insert Range("A1") = "MIS REPORT FOR THE PERIOD OF" With Range("A1:C1") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .Merge .Font.Bold = True End With Range("A6:C7").Font.Bold = True Set c = Cells.Find(What:="income", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.Range("A1:C1").Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True Set ReplaceRange = Range(c, c.End(xlUp)) ReplaceRange.Replace _ What:="cr", _ Replacement:="", _ LookAt:=xlPart c.Offset(0, 2).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)" End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Insert Set c = c.Offset(1, 0) Set LastCol = c.End(xlToRight) Set LastCell = LastCol.End(xlDown) LastRow = LastCell.Row Set ReplaceRange = Range(c, LastCell) ReplaceRange.Replace _ What:="dr", _ Replacement:="", _ LookAt:=xlPart Set FilterColumn = c.Offset(0, 2) FilterColumn.AutoFilter FilterColumn.AutoFilter Field:=1, Criteria1:="=" Set FirstFormula = c.Offset(4, 2) Set LastFormula = Cells(LastRow, FirstFormula.Column) Set PasteRange = Range(FirstFormula, LastFormula) Set VisibleRange = PasteRange.SpecialCells(xlCellTypeVisible) FirstFormula.Offset(4, 2).FormulaR1C1 = "=RC[-1]" FirstFormula.Copy VisibleRange.PasteSpecial _ Paste:=xlPasteValues Set FormulaRange = Range(c.Offset(0, 1), _ Cells(LastRow, c.Offset(0, 1).Column)) FormulaRange.clearcontnets FormulaRange.FormulaR1C1 = "=SUM(R[1]C[-1]:R[30]C[-1])" End If Set c = Cells.Find(What:="c/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then LastCol = c.End(xlToRight) Range(c, LastCol).Font.Bold = True Set LastFormula = c.End(xlToRight).ofset(-1, 0) Set FirstFormula = LastFormula.End(xlUp) LastCol.Formula = _ "=SUM(" & FirstFormula.Address & ":" & LastFormula.Address & ")" With c.Range("A1:C1") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With End If Range("A1:B44").NumberFormat = "0.00" With Range("A1:A42") .Font.Bold = False .Font.Bold = True End With Set c = Cells.Find(What:="c/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows(1).Insert c.FormulaR1C1 = "CLOSING BALANCE" c.Font.Bold = True End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.FormulaR1C1 = "PAYMENTS" c.Select End If End Sub "Kumar" wrote: I Have a Macro which was not totaling as per my criteria, i wanna To Display the amount to the respective account and Sum up the Values of expenses... This is my Macro : Columns("A:A").EntireColumn.Select Selection.Delete Shift:=xlToLeft Range("A1").Select Selection.Rows("1:6").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Selection.End(xlUp).Select Cells.Find(What:="cash inflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Range("A1").Select Cells.Find(What:="cash outflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Columns("A:A").EntireColumn.Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Replace What:="account", Replacement:="Particulars", LookAt:=xlPart _ , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="Details", Replacement:="Amount", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Find(What:="b/f", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ |
|
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Problem with Macro
I got the file and wrote the code to get your 1st results. See if this
helps. If you are still having problems let me know I will help. I can't work on this problem any more today. See if you can get the 2nd results yourself. You also may need to do some more formating with the 1st results. Sub Output1() Columns("A:A").Delete Set c = Cells.Find(What:="account", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("1:" & (c.Row - 1)).Delete End If Set c = Cells.Find(What:="cash inflow", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("2:" & c.Row).Delete End If Set c = Cells.Find(What:="cash outflow", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.ClearContents c.MergeCells = False End If Columns("A").EntireColumn.Replace _ What:=" ", _ Replacement:="", _ LookAt:=xlPart 'Insert Header Rows and format Rows(1).Insert With Range("A1:C1") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .Merge .Font.Bold = True .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 End With Range("A1") = "MIS REPORT FOR THE PERIOD OF" Rows("3:4").Insert With Rows("3:4").EntireRow .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With Range("A3") = "RECEIPTS" Range("A4") = "OPENING BALANCE" Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then c.Value = "TOTAL" Range(c, c.End(xlToRight)).Font.Bold = True Set ReplaceRange = Range("B5:C" & c.Row) ReplaceRange.Replace _ What:="cr", _ Replacement:="", _ LookAt:=xlPart c.Offset(0, 2).Formula = _ "=SUM(C5:C" & (c.Row - 1) & ")" End If '-------------- End of Receipts -------------- 'Find Last Row LastRow = Range("A" & Rows.Count).End(xlUp).Row Range("A" & LastRow) = "TOTAL" 'Add blank row Rows(LastRow - 1).Insert Range("A" & (LastRow - 1)) = "CLOSING BALANCES" 'clear previous row Rows(LastRow - 2).ClearContents Set c = Cells.Find(What:="expenses", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then StartExpenses = c.Row End If EndExpenses = c.Offset(1, 2).End(xlDown).Row - 1 Rows(EndExpenses + 1).Insert LastRow = Range("A" & Rows.Count).End(xlUp).Row Set ReplaceRange = _ Range("B" & StartExpenses & ":C" & LastRow) ReplaceRange.Replace _ What:="dr", _ Replacement:="", _ LookAt:=xlPart StartExpenseType = StartExpenses + 1 For RowCount = (StartExpenses + 1) To EndExpenses If Range("B" & RowCount) = "" Then ExpenseType = Range("A" & RowCount) StartRow = RowCount + 1 End If If Range("A" & RowCount) = "" Then Range("A" & RowCount) = ExpenseType & " TOTAL" Range("B" & RowCount) = "" Range("C" & RowCount).Formula = _ "=Sum(B" & StartRow & ":B" & (RowCount - 1) & ")" End If Next RowCount Range("C" & StartExpenses).Formula = _ "=Sum(C" & (StartExpenses + 1) & ":C" & EndExpenses & ")" Range("C" & LastRow).Formula = _ "=Sum(C" & (StartExpenses + 1) & ":C" & (LastRow - 1) & ")" End Sub "joel" wrote: I wasn't able to download the file. It looks like the file size is zero bytes. I'm also not getting an error with the code I posted. "Kumar" wrote: Hey Joel You can Find my File at the Following Link: http://www.easy-share.com/1904615394/Consolidated Cash flow.xls Pls Help me in this Regard.... "joel" wrote: I don't recommend using recorded macros without editing the code. Especially when you end up with a macro this big. When using FIND set a variable to the location so it is easier to code. I fixed your total as best as I could. It looks like you are trying to add all the values in a table. I think the table size may be veariable but your could was using a fixed size table of 23 rows. Also fixed this problem. I can't guarantee this code will work becaue of the large number of changes that were made. If yo need more help let me know. Sub Macro1() Columns("A:A").Delete Rows("1:8").Delete Set c = Cells.Find(What:="cash inflow", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Set c = Cells.Find(What:="cash outflow", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Columns("A").EntireColumn.Replace _ What:=" ", _ Replacement:="", _ LookAt:=xlPart Cells.Replace _ What:="account", _ Replacement:="Particulars", _ LookAt:=xlPart Cells.Replace _ What:="Details", _ Replacement:="Amount", _ LookAt:=xlPart Set c = Cells.Find(What:="b/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("1:2").EntireRow.Insert End If With Rows("1:2") .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 End With Range("A1") = "RECEIPTS" Range("B1") = "OPENING BALANCE" Set c = Cells.Find(What:="receipts", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete With c.Offset(-1, 0).Rows("1:2").EntireRow .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With c.Offset(0, 1) = "(Rs.)" c.Offset(0, 2) = "(Rs.)" End If Rows(1).Insert Range("A1") = "MIS REPORT FOR THE PERIOD OF" With Range("A1:C1") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .Merge .Font.Bold = True End With Range("A6:C7").Font.Bold = True Set c = Cells.Find(What:="income", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.Range("A1:C1").Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True Set ReplaceRange = Range(c, c.End(xlUp)) ReplaceRange.Replace _ What:="cr", _ Replacement:="", _ LookAt:=xlPart c.Offset(0, 2).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)" End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Insert Set c = c.Offset(1, 0) Set LastCol = c.End(xlToRight) Set LastCell = LastCol.End(xlDown) LastRow = LastCell.Row Set ReplaceRange = Range(c, LastCell) ReplaceRange.Replace _ What:="dr", _ Replacement:="", _ LookAt:=xlPart Set FilterColumn = c.Offset(0, 2) FilterColumn.AutoFilter FilterColumn.AutoFilter Field:=1, Criteria1:="=" Set FirstFormula = c.Offset(4, 2) Set LastFormula = Cells(LastRow, FirstFormula.Column) Set PasteRange = Range(FirstFormula, LastFormula) Set VisibleRange = PasteRange.SpecialCells(xlCellTypeVisible) FirstFormula.Offset(4, 2).FormulaR1C1 = "=RC[-1]" FirstFormula.Copy VisibleRange.PasteSpecial _ Paste:=xlPasteValues Set FormulaRange = Range(c.Offset(0, 1), _ Cells(LastRow, c.Offset(0, 1).Column)) FormulaRange.clearcontnets FormulaRange.FormulaR1C1 = "=SUM(R[1]C[-1]:R[30]C[-1])" End If Set c = Cells.Find(What:="c/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then LastCol = c.End(xlToRight) Range(c, LastCol).Font.Bold = True Set LastFormula = c.End(xlToRight).ofset(-1, 0) Set FirstFormula = LastFormula.End(xlUp) LastCol.Formula = _ "=SUM(" & FirstFormula.Address & ":" & LastFormula.Address & ")" With c.Range("A1:C1") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With End If Range("A1:B44").NumberFormat = "0.00" With Range("A1:A42") .Font.Bold = False .Font.Bold = True End With Set c = Cells.Find(What:="c/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows(1).Insert c.FormulaR1C1 = "CLOSING BALANCE" c.Font.Bold = True End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.FormulaR1C1 = "PAYMENTS" c.Select End If End Sub "Kumar" wrote: I Have a Macro which was not totaling as per my criteria, i wanna To Display the amount to the respective account and Sum up the Values of expenses... This is my Macro : Columns("A:A").EntireColumn.Select Selection.Delete Shift:=xlToLeft Range("A1").Select Selection.Rows("1:6").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Selection.End(xlUp).Select Cells.Find(What:="cash inflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp Range("A1").Select Cells.Find(What:="cash outflow", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate ActiveCell.Rows("1:1").EntireRow.Select Selection.Delete Shift:=xlUp ActiveCell.Columns("A:A").EntireColumn.Select Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveCell.Select Cells.Replace What:="account", Replacement:="Particulars", LookAt:=xlPart _ , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False |
|
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Problem with Macro
Thank you very much Joel it worked but as you said there's a Problem with
Formatting.. "joel" wrote: I got the file and wrote the code to get your 1st results. See if this helps. If you are still having problems let me know I will help. I can't work on this problem any more today. See if you can get the 2nd results yourself. You also may need to do some more formating with the 1st results. Sub Output1() Columns("A:A").Delete Set c = Cells.Find(What:="account", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("1:" & (c.Row - 1)).Delete End If Set c = Cells.Find(What:="cash inflow", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("2:" & c.Row).Delete End If Set c = Cells.Find(What:="cash outflow", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.ClearContents c.MergeCells = False End If Columns("A").EntireColumn.Replace _ What:=" ", _ Replacement:="", _ LookAt:=xlPart 'Insert Header Rows and format Rows(1).Insert With Range("A1:C1") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .Merge .Font.Bold = True .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 End With Range("A1") = "MIS REPORT FOR THE PERIOD OF" Rows("3:4").Insert With Rows("3:4").EntireRow .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With Range("A3") = "RECEIPTS" Range("A4") = "OPENING BALANCE" Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then c.Value = "TOTAL" Range(c, c.End(xlToRight)).Font.Bold = True Set ReplaceRange = Range("B5:C" & c.Row) ReplaceRange.Replace _ What:="cr", _ Replacement:="", _ LookAt:=xlPart c.Offset(0, 2).Formula = _ "=SUM(C5:C" & (c.Row - 1) & ")" End If '-------------- End of Receipts -------------- 'Find Last Row LastRow = Range("A" & Rows.Count).End(xlUp).Row Range("A" & LastRow) = "TOTAL" 'Add blank row Rows(LastRow - 1).Insert Range("A" & (LastRow - 1)) = "CLOSING BALANCES" 'clear previous row Rows(LastRow - 2).ClearContents Set c = Cells.Find(What:="expenses", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then StartExpenses = c.Row End If EndExpenses = c.Offset(1, 2).End(xlDown).Row - 1 Rows(EndExpenses + 1).Insert LastRow = Range("A" & Rows.Count).End(xlUp).Row Set ReplaceRange = _ Range("B" & StartExpenses & ":C" & LastRow) ReplaceRange.Replace _ What:="dr", _ Replacement:="", _ LookAt:=xlPart StartExpenseType = StartExpenses + 1 For RowCount = (StartExpenses + 1) To EndExpenses If Range("B" & RowCount) = "" Then ExpenseType = Range("A" & RowCount) StartRow = RowCount + 1 End If If Range("A" & RowCount) = "" Then Range("A" & RowCount) = ExpenseType & " TOTAL" Range("B" & RowCount) = "" Range("C" & RowCount).Formula = _ "=Sum(B" & StartRow & ":B" & (RowCount - 1) & ")" End If Next RowCount Range("C" & StartExpenses).Formula = _ "=Sum(C" & (StartExpenses + 1) & ":C" & EndExpenses & ")" Range("C" & LastRow).Formula = _ "=Sum(C" & (StartExpenses + 1) & ":C" & (LastRow - 1) & ")" End Sub "joel" wrote: I wasn't able to download the file. It looks like the file size is zero bytes. I'm also not getting an error with the code I posted. "Kumar" wrote: Hey Joel You can Find my File at the Following Link: http://www.easy-share.com/1904615394/Consolidated Cash flow.xls Pls Help me in this Regard.... "joel" wrote: I don't recommend using recorded macros without editing the code. Especially when you end up with a macro this big. When using FIND set a variable to the location so it is easier to code. I fixed your total as best as I could. It looks like you are trying to add all the values in a table. I think the table size may be veariable but your could was using a fixed size table of 23 rows. Also fixed this problem. I can't guarantee this code will work becaue of the large number of changes that were made. If yo need more help let me know. Sub Macro1() Columns("A:A").Delete Rows("1:8").Delete Set c = Cells.Find(What:="cash inflow", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Set c = Cells.Find(What:="cash outflow", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Columns("A").EntireColumn.Replace _ What:=" ", _ Replacement:="", _ LookAt:=xlPart Cells.Replace _ What:="account", _ Replacement:="Particulars", _ LookAt:=xlPart Cells.Replace _ What:="Details", _ Replacement:="Amount", _ LookAt:=xlPart Set c = Cells.Find(What:="b/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("1:2").EntireRow.Insert End If With Rows("1:2") .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 End With Range("A1") = "RECEIPTS" Range("B1") = "OPENING BALANCE" Set c = Cells.Find(What:="receipts", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete With c.Offset(-1, 0).Rows("1:2").EntireRow .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With c.Offset(0, 1) = "(Rs.)" c.Offset(0, 2) = "(Rs.)" End If Rows(1).Insert Range("A1") = "MIS REPORT FOR THE PERIOD OF" With Range("A1:C1") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .Merge .Font.Bold = True End With Range("A6:C7").Font.Bold = True Set c = Cells.Find(What:="income", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.Range("A1:C1").Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True Set ReplaceRange = Range(c, c.End(xlUp)) ReplaceRange.Replace _ What:="cr", _ Replacement:="", _ LookAt:=xlPart c.Offset(0, 2).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)" End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Insert Set c = c.Offset(1, 0) Set LastCol = c.End(xlToRight) Set LastCell = LastCol.End(xlDown) LastRow = LastCell.Row Set ReplaceRange = Range(c, LastCell) ReplaceRange.Replace _ What:="dr", _ Replacement:="", _ |
|
#8
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Problem with Macro
I was having a lot of problems figuring out how you wanted the results
formated. the sample file didn't seem to be consitant with the formating. I then tried to compare your code against the sample spreadsheet and still didn't have a clear understanding what the results should look like. "Kumar" wrote: Thank you very much Joel it worked but as you said there's a Problem with Formatting.. "joel" wrote: I got the file and wrote the code to get your 1st results. See if this helps. If you are still having problems let me know I will help. I can't work on this problem any more today. See if you can get the 2nd results yourself. You also may need to do some more formating with the 1st results. Sub Output1() Columns("A:A").Delete Set c = Cells.Find(What:="account", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("1:" & (c.Row - 1)).Delete End If Set c = Cells.Find(What:="cash inflow", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("2:" & c.Row).Delete End If Set c = Cells.Find(What:="cash outflow", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.ClearContents c.MergeCells = False End If Columns("A").EntireColumn.Replace _ What:=" ", _ Replacement:="", _ LookAt:=xlPart 'Insert Header Rows and format Rows(1).Insert With Range("A1:C1") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .Merge .Font.Bold = True .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 End With Range("A1") = "MIS REPORT FOR THE PERIOD OF" Rows("3:4").Insert With Rows("3:4").EntireRow .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With Range("A3") = "RECEIPTS" Range("A4") = "OPENING BALANCE" Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then c.Value = "TOTAL" Range(c, c.End(xlToRight)).Font.Bold = True Set ReplaceRange = Range("B5:C" & c.Row) ReplaceRange.Replace _ What:="cr", _ Replacement:="", _ LookAt:=xlPart c.Offset(0, 2).Formula = _ "=SUM(C5:C" & (c.Row - 1) & ")" End If '-------------- End of Receipts -------------- 'Find Last Row LastRow = Range("A" & Rows.Count).End(xlUp).Row Range("A" & LastRow) = "TOTAL" 'Add blank row Rows(LastRow - 1).Insert Range("A" & (LastRow - 1)) = "CLOSING BALANCES" 'clear previous row Rows(LastRow - 2).ClearContents Set c = Cells.Find(What:="expenses", _ LookIn:=xlValues, _ LookAt:=xlPart) If Not c Is Nothing Then StartExpenses = c.Row End If EndExpenses = c.Offset(1, 2).End(xlDown).Row - 1 Rows(EndExpenses + 1).Insert LastRow = Range("A" & Rows.Count).End(xlUp).Row Set ReplaceRange = _ Range("B" & StartExpenses & ":C" & LastRow) ReplaceRange.Replace _ What:="dr", _ Replacement:="", _ LookAt:=xlPart StartExpenseType = StartExpenses + 1 For RowCount = (StartExpenses + 1) To EndExpenses If Range("B" & RowCount) = "" Then ExpenseType = Range("A" & RowCount) StartRow = RowCount + 1 End If If Range("A" & RowCount) = "" Then Range("A" & RowCount) = ExpenseType & " TOTAL" Range("B" & RowCount) = "" Range("C" & RowCount).Formula = _ "=Sum(B" & StartRow & ":B" & (RowCount - 1) & ")" End If Next RowCount Range("C" & StartExpenses).Formula = _ "=Sum(C" & (StartExpenses + 1) & ":C" & EndExpenses & ")" Range("C" & LastRow).Formula = _ "=Sum(C" & (StartExpenses + 1) & ":C" & (LastRow - 1) & ")" End Sub "joel" wrote: I wasn't able to download the file. It looks like the file size is zero bytes. I'm also not getting an error with the code I posted. "Kumar" wrote: Hey Joel You can Find my File at the Following Link: http://www.easy-share.com/1904615394/Consolidated Cash flow.xls Pls Help me in this Regard.... "joel" wrote: I don't recommend using recorded macros without editing the code. Especially when you end up with a macro this big. When using FIND set a variable to the location so it is easier to code. I fixed your total as best as I could. It looks like you are trying to add all the values in a table. I think the table size may be veariable but your could was using a fixed size table of 23 rows. Also fixed this problem. I can't guarantee this code will work becaue of the large number of changes that were made. If yo need more help let me know. Sub Macro1() Columns("A:A").Delete Rows("1:8").Delete Set c = Cells.Find(What:="cash inflow", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Set c = Cells.Find(What:="cash outflow", _ After:=ActiveCell, _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete End If Columns("A").EntireColumn.Replace _ What:=" ", _ Replacement:="", _ LookAt:=xlPart Cells.Replace _ What:="account", _ Replacement:="Particulars", _ LookAt:=xlPart Cells.Replace _ What:="Details", _ Replacement:="Amount", _ LookAt:=xlPart Set c = Cells.Find(What:="b/f", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Rows("1:2").EntireRow.Insert End If With Rows("1:2") .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 End With Range("A1") = "RECEIPTS" Range("B1") = "OPENING BALANCE" Set c = Cells.Find(What:="receipts", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Delete With c.Offset(-1, 0).Rows("1:2").EntireRow .Interior.ColorIndex = xlNone .Font.ColorIndex = 0 .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With c.Offset(0, 1) = "(Rs.)" c.Offset(0, 2) = "(Rs.)" End If Rows(1).Insert Range("A1") = "MIS REPORT FOR THE PERIOD OF" With Range("A1:C1") .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .Merge .Font.Bold = True End With Range("A6:C7").Font.Bold = True Set c = Cells.Find(What:="income", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.Range("A1:C1").Font.Bold = True End If Set c = Cells.Find(What:="total (Rupees)", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then Range(c, c.End(xlToRight)).Font.Bold = True Set ReplaceRange = Range(c, c.End(xlUp)) ReplaceRange.Replace _ What:="cr", _ Replacement:="", _ LookAt:=xlPart c.Offset(0, 2).FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)" End If Set c = Cells.Find(What:="expenses", _ LookIn:=xlFormulas, _ LookAt:=xlPart) If Not c Is Nothing Then c.EntireRow.Insert Set c = c.Offset(1, 0) Set LastCol = c.End(xlToRight) Set LastCell = LastCol.End(xlDown) |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| 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 | Excel Worksheet Functions | |||
| 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 | Excel Discussion (Misc queries) | |||
| macro problem | Excel Discussion (Misc queries) | |||
| Macro problem | Excel Worksheet Functions | |||
| macro problem | Excel Worksheet Functions | |||
Linear Mode
