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:= _
|