Problem with Macro

K

Kumar

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
 
J

joel

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 said:
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
Click to expand...
 
K

Kumar

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 said:
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 said:
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
Click to expand...
Click to expand...
 
K

Kumar

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 said:
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 said:
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
Click to expand...
Click to expand...
 
J

joel

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 said:
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 said:
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 said:
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:= _
Click to expand...
Click to expand...
Click to expand...
 
J

joel

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




:

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
Click to expand...
Click to expand...
Click to expand...
 
K

Kumar

Thank you very much Joel it worked but as you said there's a Problem with
Formatting..

joel said:
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 said:
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 said:
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....

:

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:="", _
Click to expand...
Click to expand...
Click to expand...
 
J

joel

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 said:
Thank you very much Joel it worked but as you said there's a Problem with
Formatting..

joel said:
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 said:
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.

:

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

:

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)
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

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

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

Ask a Question

Similar Threads

If Cells.Find returns run-time error '91': Object variableor With block variable not set 1
Find copy data from a cell in Personal workbook and copy it to a cellin current workbook 14
Runtime Error '91' Object variable or With block variable not set 2
Sort Marco won't work in 2010 5
Macro Problem 1
Macro for Costing 0
macro to select a range from a set cell to a specified cell 6
Problem with searching through content and delete unwnated column 0

Top