VBA Excel find date period in range and do calculations within - excel

I am performing a VB function to sort out cumulative amount within a specified period with different categories. The objective is for personnel account expenses.
For example, I have in a sheet "tmp" in column A some dates, in column B a category (eg. Salary, Transport ...) and in column C the values.
I want to define a function and I have tried to set:
Function Cumulatif(Categorie As String, Debut As Date, Fin As Date) As Double
' Do the sum of a category between a starting and ending date specified
Dim Operations As Variant
Dim SpecificSum As Double
Dim i As Integer
Operations = ThisWorkbook.Sheets("tmp").Range("A1:C3")
For Each Row In Operations.Rows
SpecificSum = 0
Next
Cumulatif = SpecificSum
End Function
But I don't really know how to get the values from another sheet and do the loop in the range to set this sum. Can somebody help me on this?

The assigment to operations needs to be an object assignment, meaning: use Set (not Let/default).
Set Operations = ThisWorkbook.Sheets("tmp").Range("A1:C3)
You can get the values from the other sheet (assuming you mean "tmp") as follows
SpecificSum = SpecificSum + Row.Cells(1, 1)
I think you'd be better off having the function take an additional range parameter and supplying Sheet1!A as an argument; this way Excel will know when it needs to recalculate.
Function Cumulatif(Categorie As String, Debut As Date, Fin As Date, Operations As Range) As Double
' Do the sum of a category between a starting and ending date specified
'Dim Operations As Variant
Dim SpecificSum As Double
Dim i As Integer
'Set Operations = ThisWorkbook.Sheets("Sheet1").Range("A2:C3")
For Each Row In Operations.Rows
SpecificSum = SpecificSum + Row.Cells(1, 1)
Next
Cumulatif = SpecificSum
End Function
And call Cumulatif using such a formula:
=Cumulatif("hello9","10/1/2010", "10/31/2010",Sheet1!A2:A3)

Related

Using Match function in a nested For loop to find the closest value VBA

I have a table of data with 30 rows and 14 columns. The data is organized in ascending order. The goal of the function being created is to search through each cell to find the specific Car the user has entered. Then search the column of the Car to find the distance it can travel.Then from finding the distance row, move over to the oil column to get the value as the output. The problem I am facing is how to have the search be similar to the match function where it can find the closest value (lower in my case) while running the loop.
This is what I have prior to trying to add a match function:
Function findoil(car As String, distance As String, condition As String) As String
Dim row As Integer
Dim column As Integer
Dim temp As Integer
Dim Target As Integer
Dim oil_col As Integer
Dim sheet_tab As String
For row = 1 To 100
For column = 1 To 100
If Worksheets(sheet_tab).Cells(row, column).Value = car Then
For temp = 1 To 100
If Worksheets(sheet_tab).Cells(temp, column).Value = distance Then
For oil_col = 1 To 100
If Worksheets(sheet_tab).Cells(row, oil_col).Value = "oil" Then
findoil = Worksheets(sheet_tab).Cells(temp, oil_col)
End If
Next oil_col
End If
Next temp
End If
Next column
Next row
End Function
Using this function I can only find the value if it is exact. I would like to be able to find the closest cell in the column to the inputted value.

How to get earliest date and latest date from a Date Column which has values in the format "01/01/2019 09:01:00 AM"?

I have a column in excel with date in the given below format.
When I read the data using worksheet.cells(row, col) it is in string format
8/10/2019 9:01:00 AM
8/6/2019 9:01:00 AM
8/22/2019 9:01:00 AM
8/18/2019 9:01:00 AM
8/14/2019 9:01:00 AM
Objective is to get the earliest date and latest date and use those to filter in another excel.
Is there a simpler way to get the two dates from the date column?
For the above example I want the earliestDate = 08/06/2019 and latestDate = 08/22/2019
I don't use VBA extensively, this is the first time I am using and I am updating an existing VBA code
Say the date-like strings are in cells A1:A10 (for example).
Using array formulas
Entering the formulas below with CTRL+SHIFT+ENTER should get you smallest and largest dates respectively.
=MIN(DATEVALUE(A1:A10))
=MAX(DATEVALUE(A1:A10))
Using VBA
Option Explicit
Sub MinAndMaxDates()
Dim sourceSheet As Worksheet
Set sourceSheet = ThisWorkbook.Worksheets("Sheet2")
Dim inputArray() As Variant
inputArray = sourceSheet.Range("A1:A10") ' For example
Dim smallestDate As Date
smallestDate = CDate(inputArray(1, 1))
Dim largestDate As Date
Dim rowIndex As Long
For rowIndex = LBound(inputArray, 1) To UBound(inputArray, 1)
inputArray(rowIndex, 1) = CDate(inputArray(rowIndex, 1)) ' Or could use DateValue
smallestDate = Application.Min(smallestDate, inputArray(rowIndex, 1))
largestDate = Application.Max(largestDate, inputArray(rowIndex, 1))
Next rowIndex
End Sub
Unless you're dealing with a huge amount of dates, the above should be fine. If not, then the loop's internal logic can be improved.
(It is not possible that smallestDate and largestDate will both be assigned/changed during the same loop iteration, so they should be on separate (mutually exclusive) branches using an If-Elseif-End If instead of functions Max and Min. That way the current date is only compared once.)

Dynamic calculations by referencing table header for Excel

I'm quite new to the Macro function in Excel.
I'm working with a table with a dynamic number of columns, and while some of the calculations I can do manually in Excel, I'm trying to figure out how to automate this in VBA.
The number of columns between column G (Achieved) and P (Total % Class) may differ, but the calculations will be about the same.
I am hoping to use the Table[Header] to specify where to calculate, perhaps whichever column is on the right of 'Achieved' and left of 'Total % Class'
Total % Class:
= SUM all classes except Unclassed
Total % at Higher Class:
= SUM Class_1, Class_2, Class_2F and Class_2P together
Some of these Classes won't always appear in the data, if any one these are missing it will return a #REF error for 'Total % Class' and 'Total % at Higher Class', so I'm hoping to bypass this.
Here's a screengrab of the data, showing all the classes.
This macro assumes your data is an Excel Structured Table (if it's not, backup your workbook and consider selecting the data and pressing "Ctrl" + "T" to turn it into one)
Customize the section inside the code:
Sub DoCalcs()
' Declare objects variables
Dim excelTable As ListObject
' Declare other variables
Dim sheetName As String
Dim excelTableName As String
Dim achievedColHeader As String
Dim achievedColNum As Integer
Dim calculationColHeader As String
Dim calculationColNum As Integer
Dim firstColHeader As String
Dim lastColHeader As String
'>>>>>>>>Customize to fit your needs
sheetName = "Sheet1"
excelTableName = "Table1"
achievedColHeader = "Achieved"
calculationColHeader = "Total % Class"
'<<<<<<<<
' Initialize the listobject
Set excelTable = ThisWorkbook.Worksheets(sheetName).ListObjects(excelTableName)
' Get the column number of the first column
achievedColNum = excelTable.HeaderRowRange.Find(achievedColHeader).Column
' Get the column number of the calculation column
calculationColNum = excelTable.HeaderRowRange.Find(calculationColHeader).Column
' Get first and last columns headers of sum's range
firstColHeader = excelTable.HeaderRowRange.Columns(achievedColNum + 1)
lastColHeader = excelTable.HeaderRowRange.Columns(calculationColNum - 1)
' Set the calculation formula in cell
excelTable.DataBodyRange.Columns(calculationColNum).Formula = "=SUM(Table1[#[" & firstColHeader & "]:[" & lastColHeader & "]])"
End Sub

VBA Code to Populate Balance Sheet from Trial Balance Data

Good afternoon folks,
I've been a long time reader but first time poster. I am doing a project that requires me to take trial balance data in Excel and format that data into a "balance sheet".
Basically I have the trial balance data in one worksheet ("Data") and the balance sheet template in another sheet ("Balance Sheet")
I need to populate the balance sheet from the ("Data") sheet to the ("Balance Sheet"). I am having trouble wrapping my head around how to do this
I have a first macro that I recorded that formats the trial balance data by account number and a second macro that sums together each group of accounts (ex. all cash accounts on are summed together on one line in the balance sheet).
But I am having trouble making this code robust and flexible, currently it is hard coded to the values in the balance sheet. How can I make this code flexible so that it populates correctly, (for example, if I added another "cash" account to the cash group, it would add that amount to the "cash" line in the balance sheet)
Here is the file if needed to look into it. Not a whole lot of code so any help would be greatly appreciated!
http://s000.tinyupload.com/?file_id=22382427361802516291
http://imgur.com/a/bYjUp
I haven't downloaded your project yet but it seems that what you need to do is create an array for each type of account. For simplicity, let's say you just have arrCash and arrLiability. You would then fill the arrays with each known gl code.or another way would be to keep a list of gl codes on a seperate spreadsheet. Now comes the fun part. You would loop through your excel spreadsheet and compare each code to the elements in your arrays. If the comparison equals true then add that amount to a one of your variables. If the comparison equals false then create a routine that redims the array the gl code needs to be added to then adds that gl code to the array. Or adding to that seperate spreadsheet. After adding the new gl code to the array you would need to add that amount to it's corresponding variable. After all calculations are completed, then you would update your balance sheet with the amoubts in the variables. Easy enough, right?
The following function accepts a comma delimited list of values (the value from column a in Data sheet) and will sum all rows in the data sheet that match the provided values.
eg: ?getSum("10300-000,10303-000") = 433094.74
Public Function getSum(ByVal Search As String) As Double
Dim Data As Worksheet: Set Data = ThisWorkbook.Worksheets("Data")
Dim List() As String: List = Split(Search, ",")
Dim ListSize As Integer: ListSize = UBound(List)
Dim Values() As Variant
Dim Row As Integer
Dim Rows As Integer
Dim Match As Integer
Dim Matched As Boolean
Dim Result As Double: Result = 0
Rows = Data.Range("A" & Data.Rows.Count).End(xlUp).Row
Values = Data.Range("A1", "C" & Rows).Value2
Row = 1
Do
Matched = False
For Match = 0 To ListSize
If Values(Row, 1) = List(Match) Then
Matched = True
Exit For
End If
Next Match
If Matched = True Then
Result = Result + CDbl(Values(Row, 3))
End If
If Row >= Rows Then
Exit Do
Else
Row = Row + 1
End If
Loop
getSum = Result
End Function
Updated to allow range of accounts instead of list
Public Function getSum2(ByVal sFirst As String, ByVal sLast As String) As Double
Dim Data As Worksheet: Set Data = ThisWorkbook.Worksheets("Data")
Dim Values() As Variant
Dim Row As Integer
Dim Rows As Integer
Dim First As Long: First = CLng(Left(sFirst, 5))
Dim Test As Long
Dim Last As Long: Last = CLng(Left(sLast, 5))
Dim Result As Double: Result = 0
Rows = Data.Range("A" & Data.Rows.Count).End(xlUp).Row
Values = Data.Range("A1", "C" & Rows).Value2
Row = 1
Do
Test = CLng(Left(Values(Row, 1), 5))
If Test >= First And Test <= Last Then
Result = Result + CDbl(Values(Row, 3))
End If
If Row >= Rows Then
Exit Do
Else
Row = Row + 1
End If
Loop
getSum2 = Result
End Function

How to make a cell conditionally negative? (Excel)

I am dealing with monthly accruals in an Excel worksheet. I want to write a function or macro that makes it so when the month changes the values become negative.
What I have is a column (K) where it has the month, and another cell (M18) that has the month, And I want the values in the Amount (N) column to become negative if K=M18. But
=if($K21=$M$18,N=N*-1,"") doesn't work. I can write another column off to the side, say Q, where I can write =if($K21=$M$18, N*-1, ""), but I really need for the value in the N column itself to be negative. Is there a way to write a macro or nested functions to replace the value of N with a negative version of itself conditionally? If I have to make the value of negative N calculate in Q, can I then make a second function that goes back and makes N=Q?
K___L__M______N
____Input previous month
____February
___**Venue_Vendor_Amount**
February _______1,666
February ______3,240
February _______718
Here's a macro to do the trick:
Sub AccrualsMacro()
Dim rngN As Range
Dim clVal As Double
Dim cl As Range
Dim makeNegative As Boolean
makeNegative = [K21] = [M18]
If makeNegative Then
Set rngN = Range("N1", Range("N1").End(xlDown))
For Each cl In rngN
With cl
clVal = .Value
If Not clVal < 0 Then 'only apply this rule if the value is still positive
.Value = -1 * clVal
End If
End With
Next
End If
End Sub

Resources