I have a monthly creditor file (create new tab for each month when required) and want to calculate the amount outstanding each month, which is represented by those cells that have no shading.
I need the vba code to apply to each sheet (across the workbook) so that it will calculate this for me in each monthly tab - the below vba code works for one month only, but errors out when I try to replicate it in another month.
Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult
lCol = rColor.Interior.ColorIndex
If SUM = True Then
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = WorksheetFunction.SUM(rCell, vResult)
End If
Next rCell
Else
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = 1 + vResult
End If
Next rCell
End If
ColorFunction = vResult
End Function
Unfortunately I'm no expert on vba, but with trial and error and someone's assistance they can help me achieve what I need.
Note, I only create a tab for each month when required - maybe they all need to be created as part of the initial template and is it important that the row and column references are the same in each tab when performing the calculation (=colorfunction(A4,range,True).
Well the problem is, you do not define the worksheet. Define a variable of sheet and pass that as you do with other parameters in the COLORFUNCTION function.
Then after you can pass that without error, you add in a loop for each sheet.
The syntax for counting sheets is as follows:
tabcount=Thisworkbook.worksheets.count
Then you loop to it:
For tab=1 to tabcount
Then you can activate any sheet (tab) by the index number, as in:
Thisworkbook.worksheets (tab)
This is a wireframe only. I will not construct a complete working code, as my goal is to teach you how, not just cut and paste.
Unfortunately, I may have overstated/implied my vba ability.
I think I understand what it is that the vba coding requires to work, but I am not knowledgeable enough to code this and know at which point to insert into the coding that already exists (which I also got from the internet).
I would really appreciate if you could provide the coding and then and I can step through it to see how it works and the manner in which it is constructed.
And absolutely, I do want to learn it, but lets not walk before I can crawl :-)
There are dudes that are way better at codeing Excel then me, that ussually drop in later in the week. Please understand, if I dont get back to this, someone will assist.
Based on this I introduced the following code at the start of my vba, again got on the internet, and having tested it in my file it seems to be working okay. Not sure if it covers everything you were suggesting.
Sub kl()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
'be aware as this might produce an error, if Shet "name" does not exist
Set ws = wb.Sheets("name")
' if wb is other than the active workbook
wb.Activate
ws.Select
Ok, I found where you cut that function from, and deployed it into my own workbook. I deployed it in a new module, called Module1. I added in five new sheets. Selected the last sheet and set up a yellow cell in A1. Placed a value of five in cell A2, and colored the cell the same yellow. Then in cell D1, placed the following =ColorFunction (A1, A2:G9, true) and it returned the five. If I push false, it counts the two yellow cells, as it should. So the function will work on added sheets as written. If you do not get a valid entry on a newly created sheet, then check to make certain you have not deployed the function on a worksheet, but in a common module to all sheets.
Ok, lets look at it like this, the yellow should only be there for HUMANS BENEFIT. So what we need is a simple calculation of outstanding accounts. The calculations should be first, then the colors. The code that you have used, looks at the colors first for calculations.
It is very simple if we look at the value calculations first, then as a result of those, they get a color feedback for your workers.
Stop and read this entire post, as if you just cut and paste, it will wreck your current sheet, altering cells! DEPLOY AT YOUR RISK, OR DEPLOY on A COPY!
Requirements:
In the function CalcRow, make certain that the pCell(payment cell) is the correct Column.
In the function CalcRow, make certain that the bCell(balance cell) is the correct Column.
In the function CalcRow, make certain that the cCell(calculated cell) is the correct Column.
The below code starts by running StartCalc.
StartCalc loads a vriable called SheetNumMax with a call to the function counttabs. Count tabs counts and returns the number of sheets in the workbook.
StartCalc then loops through each sheet, and calls a function named FindLastRow, to see how many rows there are on the current sheet.
FindLastRow initializes a variable of rownum, and we loop though each row with the variable "t".
During the loop, we call CalcRow, to perform the claculations of Outstanding balances.
CalcRow also calls for checking the value of cCell, by calling CheckVal and passing cCell.
CheckVal looks at the value of cCell, and if it is greater than 0, it colors the cell yellow.
Function StartCalc() Dim SheetNumMax Dim rownum SheetNumMax = counttabs For st = 1 To SheetNumMax ThisWorkbook.Worksheets(st).Activate rownum = FindLastRow(st) For t = 2 To rownum CalcRow (t) Next Next End Function
Function counttabs() Dim numTabs numTabs = ThisWorkbook.Worksheets.Count counttabs = numTabs End Function
Function FindLastRow(OnWhatsheet) FindLastRow = Cells(ThisWorkbook.Worksheets(OnWhatsheet).Rows.Count, 1).End(xlUp).Row
End Function
Function CalcRow(whatrow) Dim bCell, pCell, cCell pCell = "A" & whatrow bCell = "B" & whatrow cCell = "C" & whatrow theval = Range(bCell).Value - Range(pCell).Value MsgBox (theval) 'remark out this line if you do not wish to have feedback of totals! Range(cCell).Value = theval CheckVal (cCell) End Function
Sub CheckVal(whatcell) If Range(whatcell).Value > 0 Then Range(whatcell).Interior.ColorIndex = 6 'yellow End If End Sub
Unfortunately, I may have overstated/implied my vba ability.
I think I understand what it is that the vba coding requires to work, but I am not knowledgeable enough to code this and know at which point to insert into the coding that already exists (which I also got from the internet).
I would really appreciate if you could provide the coding and then and I can step through it to see how it works and the manner in which it is constructed.
And absolutely, I do want to learn it, but lets not walk before I can crawl :-)
Merci
Michael
- Posts
- 13031
- Registration date
- Monday June 3, 2013
- Status
- Moderator
- Last seen
- October 11, 2019
1576- Posts
- 13031
- Registration date
- Monday June 3, 2013
- Status
- Moderator
- Last seen
- October 11, 2019
1576Based on this I introduced the following code at the start of my vba, again got on the internet, and having tested it in my file it seems to be working okay. Not sure if it covers everything you were suggesting.
Sub kl()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
'be aware as this might produce an error, if Shet "name" does not exist
Set ws = wb.Sheets("name")
' if wb is other than the active workbook
wb.Activate
ws.Select
End Sub
Thanks again for your guidance.
Can anyone advise what may be missing from my vba coding to prevent having to do this and manually re-apply the formula monthly.
Thankyou