📜 ⬆️ ⬇️

Excel is my financial auditor

Hello to all. A little background.
Like, for sure, any wife, my loves to count money. Moreover, it is not easy: "how much they earned and how much they spent." No, she divides them into groups and counts them every day. This business is quite tedious and takes quite a lot of time, which is why I often see my beloved sitting with my back to me. To make her work easier, and because of my mercenary motives, I made a small accountant.

For several days I was asking what she wanted from the reader. At the cost of unthinkable efforts turned out to be a rather small list:

Requirements


Selection


Like any programmer, I had a question: “What should I write on?”. There were many options from Python to Java. But, since I am a rather lazy person, I didn’t want to draw buttons. And here I looked at Excel more closely. “So here is the interface,” I said to myself. And the truth is that it can explain even more clearly where your money has gone, than the table (I'm not talking about infographics), and everyone can work with it.

Process


So, we create an Excel workbook, there are three sheets by default, that’s enough for us.
')
The first sheet ("Sheet 1")

In the line "1" we enter the date, amount, card / cash, total

image

So, the column "Date" has the format "Date", "Amount" - Money, rounded to the whole. With the "Card / Cash" column you have to tinker a bit. To begin with we will make the list which will fall out in this column.
Press "Ctrl" + "Right Arrow", and we will be in the rightmost column of the sheet. Here we write the list:

Now we will get on the “D2” cell and press “Ctrl” + “Down arrow”. So we select the entire column without a cap.
Create a drop-down list for these cells. “Data” -> “Verification ...”. In the open window, select "Data Type": "List", and in the "Source" indicate the column in which the list was written, I have an example of "= $ IV: $ IV".
We select the entire column so that if we add an item, we will not need to reassign the menu.
Now our cells have a drop-down list.

image

And finally, in the column “Total” in cells “D2”: the formula will be like this - "= SUM (B2: B65536)"
The first sheet is ready. Here will be our income.

The second sheet ("Sheet 3")

Here everything is the same, only instead of the column “Card / Cash” there will be a column “For what”, and the drop-down list will change, mine, for example, so far contains such entries.

The third sheet ("Data")

The most interesting. Sheet looks like this:
image

In cell A2, the formula is "= Sheet1! D2-Sheet3! D2", and add another graph to the sheet.

image

It seems to me that the circular is clearer.

Now create a panel to make it easier to run macros. Right-click on ToolBar `->" Settings "button" Create ". My menu is called “MyToolBar”, this name will be used in the macro, so if you change, do not forget to change it there.
We have ToolBar, press "Alt" + "F11".
Macro for creating buttons in ToolBar`e:

Public Sub InitToolBar()
Dim cmdBarSm As CommandBar
Dim ctlNewbtn As CommandBarButton
'Application.CommandBars("MyToolBar").Controls(" ").Delete
'Application.CommandBars("MyToolBar").Controls(" ").Delete
'Application.CommandBars("MyToolBar").Controls(" ").Delete
Set cmdBarSm = Application.CommandBars("MyToolBar")
Set ctlNewbtn = cmdBarSm.Controls.Add(msoControlButton)
ctlNewbtn.Caption = " "
ctlNewbtn.FaceId = 26
ctlNewbtn.OnAction = "getMonth"
Set ctlNewbtn = cmdBarSm.Controls.Add(msoControlButton)
ctlNewbtn.Caption = " "
ctlNewbtn.FaceId = 28
ctlNewbtn.OnAction = "getDay"
Set ctlNewbtn = cmdBarSm.Controls.Add(msoControlButton)
ctlNewbtn.Caption = " "
ctlNewbtn.FaceId = 31
ctlNewbtn.OnAction = "GetGroup"
End Sub

In the code behind the command to remove these buttons. For the first time, the macro will have to be run like this, otherwise it swears that it cannot find the buttons.
We created three buttons for calculating costs: By Day, By Month, By Group; Icons are set in FaceId, called macros in OnAction.

So the getMonth macro:

Sub getMonth()
Dim ActSheet As Worksheet
Dim BeginCell As Integer
Dim SumCell As Integer
Dim CurSumCell As Integer
Dim NewData As Boolean
Dim CurData As Date
Dim ValueP As Integer
Dim MonthNow As String

'
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActSheet.Range("A5", "D65536").Select
Selection.Clear
'
Set ActSheet = Worksheets.Item("3")
BeginCell = 2
CurSumCell = 5
ActSheet.Activate

While ActSheet.Cells(BeginCell, 1).Value <> Empty
NewData = True
SumCell = 5
CurData = ActSheet.Cells(BeginCell, 1).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
'
While ActSheet.Cells(SumCell, 1).Value <> Empty
If MonthName(Month(CurData)) = ActSheet.Cells(SumCell, 1).Value Then
NewData = False
End If
SumCell = SumCell + 1
Wend
'
If NewData Then
ActSheet.Cells(CurSumCell, 1).Value = MonthName(Month(CurData))
Set ActSheet = Worksheets.Item("3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActSheet.Cells(CurSumCell, 3).Value = ActSheet.Cells(CurSumCell, 3).Value + ValueP
CurSumCell = CurSumCell + 1
End If
'
If Not NewData Then
Set ActSheet = Worksheets.Item("3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActSheet.Cells(CurSumCell - 1, 3).Value = ActSheet.Cells(CurSumCell - 1, 3).Value + ValueP
End If
Set ActSheet = Worksheets.Item("3")
ActSheet.Activate
BeginCell = BeginCell + 1
Wend

'
Set ActSheet = Worksheets.Item("1")
BeginCell = 2
CurSumCell = 5
ActSheet.Activate

' A
While ActSheet.Cells(BeginCell, 1).Value <> Empty
NewData = True
SumCell = 5
CurData = ActSheet.Cells(BeginCell, 1).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
'
MonthNow = ActSheet.Cells(SumCell, 1).Value
While ActSheet.Cells(SumCell, 1).Value <> Empty
If MonthName(Month(CurData)) = ActSheet.Cells(SumCell, 1).Value Then
NewData = False
End If
SumCell = SumCell + 1
Wend
'
If NewData Then
ActSheet.Cells(CurSumCell, 1).Value = MonthName(Month(CurData))
Set ActSheet = Worksheets.Item("1")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActSheet.Cells(CurSumCell, 2).Value = ActSheet.Cells(CurSumCell, 2).Value + ValueP
CurSumCell = CurSumCell + 1
End If
'
If Not NewData Then
Set ActSheet = Worksheets.Item("1")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value

Set ActSheet = Worksheets.Item("")
ActSheet.Activate
If ActSheet.Cells(CurSumCell - 1, 1).Value <> MonthName(Month(CurData)) Then
ActSheet.Cells(CurSumCell, 4).FormulaR1C1 = "=RC[-2]-RC[-1]"
CurSumCell = CurSumCell + 1
End If
ActSheet.Cells(CurSumCell - 1, 2).Value = ActSheet.Cells(CurSumCell - 1, 2).Value + ValueP
End If
Set ActSheet = Worksheets.Item("1")
ActSheet.Activate
BeginCell = BeginCell + 1
Wend
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
End Sub


GetDay macro:

Sub getDay()
Dim ActSheet As Worksheet
Dim BeginCell As Integer
Dim SumCell As Integer
Dim CurSumCell As Integer
Dim NewData As Boolean
Dim CurData As Date
Dim ValueP As Integer
Dim MonthNow As String

'
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActSheet.Range("F5", "G65536").Clear
'
Set ActSheet = Worksheets.Item("3")
BeginCell = 2
CurSumCell = 5
ActSheet.Activate

While ActSheet.Cells(BeginCell, 1).Value <> Empty
NewData = True
SumCell = 5
CurData = ActSheet.Cells(BeginCell, 1).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
'
While ActSheet.Cells(SumCell, 6).Value <> Empty
If CurData = ActSheet.Cells(SumCell, 6).Value Then
NewData = False
End If
SumCell = SumCell + 1
Wend
'
If NewData Then
ActSheet.Cells(CurSumCell, 6).Value = CurData
Set ActSheet = Worksheets.Item("3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActSheet.Cells(CurSumCell, 7).Value = ActSheet.Cells(CurSumCell, 7).Value + ValueP
CurSumCell = CurSumCell + 1
End If
'
If Not NewData Then
Set ActSheet = Worksheets.Item("3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActSheet.Cells(CurSumCell - 1, 7).Value = ActSheet.Cells(CurSumCell - 1, 7).Value + ValueP
End If
Set ActSheet = Worksheets.Item("3")
ActSheet.Activate
BeginCell = BeginCell + 1
Wend

Set ActSheet = Worksheets.Item("")
ActSheet.Activate
End Sub

And finally the last getgroup
Sub GetGroup()
Dim ActSheet As Worksheet
Dim BeginCell As Integer
Dim SumCell As Integer
Dim CurSumCell As Integer
Dim NewData As Boolean
Dim CurGroup As String
Dim ValueP As Integer

Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActSheet.Range("I5", "J65536").Clear
Set ActSheet = Worksheets.Item("3")
BeginCell = 2
CurSumCell = 5
ActSheet.Activate

While ActSheet.Cells(BeginCell, 3).Value <> Empty
NewData = True
SumCell = 5
CurGroup = ActSheet.Cells(BeginCell, 3).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
'
While ActSheet.Cells(SumCell, 9).Value <> Empty
If CurGroup = ActSheet.Cells(SumCell, 9).Value Then
NewData = False
CurSumCell = SumCell + 1
End If
SumCell = SumCell + 1
Wend
'
If NewData Then
If ActSheet.Cells(CurSumCell, 9).Value <> Empty Then
CurSumCell = CurSumCell + 1
End If
ActSheet.Cells(CurSumCell, 9).Value = CurGroup
Set ActSheet = Worksheets.Item("3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActSheet.Cells(CurSumCell, 10).Value = ActSheet.Cells(CurSumCell, 10).Value + ValueP
CurSumCell = CurSumCell + 1
End If
'
If Not NewData Then
Set ActSheet = Worksheets.Item("3")
ActSheet.Activate
ValueP = ActSheet.Cells(BeginCell, 2).Value
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActSheet.Cells(CurSumCell - 1, 10).Value = ActSheet.Cells(CurSumCell - 1, 10).Value + ValueP
End If
Set ActSheet = Worksheets.Item("3")
ActSheet.Activate
BeginCell = BeginCell + 1
Wend
Set ActSheet = Worksheets.Item("")
ActSheet.Activate
ActiveSheet.Shapes("Chart 1").Select
ActiveChart.SetSourceData Source:=Sheets("").Range("I5:J" + CStr(CurSumCell - 1)), PlotBy:= _
xlColumns
End Sub


Here is an interesting moment.
ActiveSheet.Shapes("Chart 1").Select
ActiveChart.SetSourceData Source:=Sheets("").Range("I5:J" + CStr(CurSumCell - 1)), PlotBy:= _
xlColumns

In the Range, do not forget to specify your range, if you, of course, changed the formatting of the "Data" sheet.

Conclusion


Now everything is ready. I, of course, do not pretend to the ideal macro code, but it copes well with its task. I think that this reader will be useful to many and will save some time to spend it with their loved ones on these New Year holidays.

Source: https://habr.com/ru/post/111412/


All Articles