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
Related
I have a function that aims to return the visible cells (as a range) after applying an autofilter to an inactive worksheet; the autofilter data is
represented by the range "filteredData" passed to the function. The returned range can then be looped through by the calling code obtaining various
values from the nth row.
I now understand that if the filtered data contains non-contiguous row groupings, only the first group of those rows is returned as a range, using
.SpecialCells(xlCellTypeVisible), and that each of those non-contiguous row groupings is represented by an item, all contained
by the same, single Areas collection - I think.
Is it possible to "convert" those area items into an overall range object? I have tried using the Address property of the item and UNION,
but this only seems to work for the first area item and seems to fail silently when attempting to add a second; no error occurs, but the row count of the
newRange remains unchanged.
Several other scripts are tied into this function and I would like to try to avoid a large re-write.
Any advice would be appreciated.
Thanks
Function getFilteredData(filteredData As Range) As Range
Dim areasData As Range
Dim areaCount As Long
Dim j As Long
Dim areaRg As Range
Dim sheetName As String
Dim newRange As Range
Dim itemAddress AS String
Dim itemRg AS Range
Set areasData = filteredData.Resize(filteredData.Rows.Count - 1, filteredData.Columns.Count).Offset(1).SpecialCells(xlCellTypeVisible)
sheetName = "'" & filteredData.Parent.Name & "'!"
areaCount = areasData.Areas.Count
For j = 1 To areaCount
'unsure if this can be treated as a range...possibly Area object
Set areaRg = areasData.Areas.item(j)
itemAddress = sheetName & areaRg.CurrentRegion.Address
Set itemRg = Range(itemAddress)
If j = 1 Then
Set newRange = itemRg
Else
Set newRange = Union(newRange, itemRg)
End If
Next j
Set getFilteredData = newRange
End Function
Given your use case of looping through the nth row you could use a utility function, e.g.
Function getRangeRowNum(data As Range, num As Long) As Range
If num < 1 Then num = 1
If data.Areas.Count = 1 Then
If num > data.Rows.Count Then
Set getRangeRowNum = data.Rows(data.Rows.Count)
Else
Set getRangeRowNum = data.Rows(num)
End If
Exit Function
End If
Dim i As Long, runRows As Long
For i = 1 To data.Areas.Count
runRows = runRows + data.Areas(i).Rows.Count
If runRows >= num Then Exit For
Next i
If i > data.Areas.Count Then 'Exit For not executed so return last actual row'
Set getRangeRowNum = data.Areas(i - 1).Rows(data.Areas(i - 1).Rows.Count)
Else
Set getRangeRowNum = data.Areas(i).Rows(num - (runRows - data.Areas(i).Rows.Count))
End If
End Function
Sub testFunction()
Dim i As Long, total As Range
Set total = Application.Union(Range("A5:H6"), Range("A9:H12"), Range("A15:H18"))
Debug.Print "Rows property of 'Total' returns " & total.Rows.Count
Debug.Print "Actual number of rows in 'Total' = " & total.Cells.Count / total.Columns.Count
For i = 1 To 10
Debug.Print getRangeRowNum(total, i).Address
Next i
End Sub
If you do intend to continue with filtering ranges though, I think some re-factoring will be inevitable.
An alternative you might consider is to pass an array between your various scripts, since an array is a properly contiguous structure.
Such an array could be constructed from an ADODB.Recordset object, e.g. this video illustrates data being read into one from a closed workbook (although it works just as well for the workbook you have open, provided all changes are saved, since it is the 'disk copy' that is queried).
With this approach you define your filter in SQL (so it could actually be more sophisticated than with AutoFilter), and the filtered results are what are read into the Recordset. The video illustrates getting data 'out of' the RecordSet, but this one shows how you can also transfer it to an array (although you probably will want to use Application.Transpose to have it in the expected form - you should also test thoroughly if you have long ranges, as Transpose didn't always work with more than 65,536 items).
This snippet illustrates how you can also create a RecordSet directly from a range, although I don't know that it's as efficient as the SQL approach. Regardless of how you populate the RecordSet, it has Filter and Sort properties (illustrated in the previous link) such that you can continue to manipulate the data directly in memory before generating the array required.
I have a sheet with some data, the Column B have names of clients and the Column D have stored Serial Numbers of equipments, if one client have more then one equipment, I just put a line break and keep adding S/N, to me it was the easy way to go at the time, but now I'm working on another sheet in the same workbook and want to pull the Name of the client when I type the Serial Number, if the client has only one equipent, the code works fine, but when try to search a serial number that is stored together in the same cell it give me an error "Run-time error'13': Type mismatch".
This is what I have so far..
Private Sub CommandButton2_Click()
If Me.listadeinv.Value <> "" Then
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Monitoramento")
Dim i As Integer
Dim sh2 As Worksheet
Set sh2 = ThisWorkbook.Sheets("Clientes")
Dim i2 As Integer
i = Application.Match(VBA.CVar(Me.listadeinv.Value), sh2.Range("D:D"), 0)
Me.nome.Caption = sh2.Range("B" & i).Value
End If
End Sub
The only workarround I found by myself was create a new sheet, put every Serial Number there in single cells and use this code to find the owner of the equipment, this is exacly what I want to do, but using VBA code.
=VLOOKUP(" * " & B1 & " * " ; CHOOSE({1\2}; Clientes!$D$2:$D$497; Clientes!$B$2:$B$497); 2; 0)
Please try the following if it works:
' do not use Integer for row variables, values are limited to -32,768 to 32,767
Dim i As Long
' wrap with asterisk your serial number for partial match, I use cast it to String instead of variant
strSerialNum = "*" & Cstr(Me.listadeinv.Value) & "*"
' variable "i" may now accept values more than 32,767,
i = Application.Match(strSerialNum, sh2.Range("D:D"), 0)
This question already has answers here:
VBA WorksheetFunction.Sum doesn't work with array but works with range?
(2 answers)
Closed 3 years ago.
Clean up your code, kiddies. After much wailing and gnashing of teeth, the problem turned out to be the extra parentheses I had in my .Sum arguments. Big thanks to #BigBen and #JvdV.
The Problem: Worksheetfunction.Sum returns a sum of 0 for a dynamic range, but only for rows.count > 1 and only for currency-formatted reference data.
More Detail: I have a userform set up to scrape a reference workbook and return a different number into each of four different textboxes based on user input. On occasion the numbers will need to be a sum of several rows on the reference workbook. Using my code below, this works like a dream for every return textbox as long as the number of rows is 1, but returns 0 (or $0.00 as it were) for anything else. However, it works just fine in all circumstances for the one sum that is just an integer. The rest are formatted as currency.
What I've done: Using MsgBoxes I've verified that the dynamic range returns the correct addresses, i.e. all cells I want summed and that the numbers at those addresses are in fact numbers and not text (verified by a True return for IsNumber). I've tried using .Subtotal and .Aggregate to see if those might help, but I ran into Missing Object and other errors and ran away whimpering because I'm new to VBA.
The Code:
My basic logic is as follows: Search in every sheet of the reference (csrWorkbook) for textbox.value. Once found, measure the height of the merged area (I know I know, but the merging decision is made above my paygrade). Offset to the right to find 4 different related quantities. Sum these quantities if multiple rows exist. Return the sum to four different textboxes.
Help!
Private Sub ScrapeButton_Click()
'Enter search term into first TB
'click search button
'result DOES(!!) appear in second TB
'Variables
Dim csrWorkbook As Workbook
Dim refWorkbook As Workbook
Dim refVariables As Worksheet
Dim csrFilePath As String
Dim csrFileName As String
Dim slinAddress As String
Dim ws As Worksheet
Dim sheetCount As Long
Dim rowCount As Long
Dim slinCell As Excel.Range
Dim quantCells As Excel.Range
Dim costCells As Excel.Range
Dim feeCells As Excel.Range
Dim totalCells As Excel.Range
Dim i As Integer
Dim iCost As Double
Dim iFee As Double
Dim iTotal As Double
Set refWorkbook = Workbooks("AutomationBackbone.xlsm")
csrFileName = refWorkbook.Sheets("Variable Storage").Range("A2").Value
Set csrWorkbook = Workbooks(csrFileName)
sheetCount = csrWorkbook.Sheets.Count
'search all worksheets for data in a known column
For i = 1 To sheetCount
Set slinCell = csrWorkbook.Sheets(i).Range("C1:C100").find(Me.TextBox1.Value)
If Not slinCell Is Nothing Then
'Find sums and populate
rowCount = slinCell.MergeArea.Rows.Count 'count the number of rows in merged area
Set quantCells = slinCell.Offset(0, 2).Resize(rowCount, 1) 'establish a new range of that same height
Set costCells = quantCells.Offset(0, 6)
Set feeCells = quantCells.Offset(0, 7)
Set totalCells = quantCells.Offset(0, 8)
Me.iQuantityTB.Value = Application.WorksheetFunction.Sum((quantCells)) 'populate the Initial Quantity
iCost = Application.WorksheetFunction.Sum((costCells)) 'find sum of Cost range
iFee = Application.WorksheetFunction.Sum((feeCells)) 'find sum of Fee range
iTotal = Application.WorksheetFunction.Sum((totalCells)) 'find sum of Total range
Me.iCostTB.Value = iCost 'populate textboxes
Me.iFeeTB.Value = iFee
Me.iTotalTB.Value = iTotal
'original code commented out to see if being more explicit helped.
'Narrator: it didn't
'Me.iCostTB.Value = Application.WorksheetFunction.Sum((quantCells.Offset(0, 6))) 'populate the Initial Cost
'Me.iFeeTB.Value = Application.WorksheetFunction.Sum((quantCells.Offset(0, 7))) 'populate the Initial Fee
'Me.iTotalTB.Value = Application.WorksheetFunction.Sum((quantCells.Offset(0, 8))) 'populate the Initial Total
Exit Sub
End If
Next i
End Sub
Edit: Pics added for clarity.
Parentheses strike again!
Including the extra parentheses causes the inner expression to be evaluated, and the result to be passed to Sum.
So
Application.WorksheetFunction.Sum((costCells))
is equivalent to
Application.WorksheetFunction.Sum(costCells.Value)
which returns zero when the underlying data is Currency.
As a small reproducible example for Sums behavior here (which is not what I expected):
Dim x(0 To 1) As Currency
x(0) = 1
x(1) = 2
Debug.Print Application.Sum(x) '<~ returns zero.
Note that .Value2 does not use the Currency data type, and the line
Application.WorksheetFunction.Sum(costCells.Value2)
would return the correct result regardless of the underlying value.
Note that similar behavior has been noted and explained here.
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
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)