VBA Code to apply in each monthly worksheetClosed

Question

Hi,

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).

Many thanks in advance.
Michael

ac3mark · Answer

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.

ac3mark · Answer

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.


 please take note of the tab in below picture

ac3mark · Answer

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.

ac3mark · Answer

I will simplify what I have in code and post back.  Then we can do the cell coloring after we get the calculatiosn running on every sheet.

ac3mark · Answer

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 SheetNumMaxDim rownumSheetNumMax = counttabs        For st = 1 To SheetNumMax        ThisWorkbook.Worksheets(st).Activate        rownum = FindLastRow(st)                For t = 2 To rownum                CalcRow (t)                Next        NextEnd Function
Function counttabs()Dim numTabsnumTabs = ThisWorkbook.Worksheets.Countcounttabs = numTabsEnd Function
Function FindLastRow(OnWhatsheet)    FindLastRow = Cells(ThisWorkbook.Worksheets(OnWhatsheet).Rows.Count, 1).End(xlUp).Row    End Function

Function CalcRow(whatrow)Dim bCell, pCell, cCellpCell = "A" & whatrowbCell = "B" & whatrowcCell = "C" & whatrowtheval = Range(bCell).Value - Range(pCell).ValueMsgBox (theval)   'remark out this line if you do not wish to have feedback of totals!Range(cCell).Value = thevalCheckVal (cCell)End Function

Sub CheckVal(whatcell)    If Range(whatcell).Value > 0 Then    Range(whatcell).Interior.ColorIndex = 6 'yellow    End IfEnd Sub

Micwhsct · Answer

Thank you ac3mark,

Unfortunately with other priorities I will not get the opportunity to review until next week, but thanks again.

VBA Code to apply in each monthly worksheet

6 replies

Subscribe To Our Newsletter!