edit the program to sumif with visible cells in MS excel - excel

i got some countifv thats counts visible and sumifsv which sum visible cells only ... i want sumif only visible using vba
Default Using SUMIFS on visible lines only
I have a large table, lots of rows and lots of columns that has material (Sand, stone, etc.) batched information. I wanted to be able to allow the user to use filters to select which data they want to view, then be able to review some summary information (totals by hour of the day, totals by material, etc.) on other sheets.
I had it working really well and fast using DSUM and/or SUBTOTAL, but these functions don't exclude non-visible (Filtered) lines in a list.
Using some previous posts I saw on this site, I was able to come up with something that works, but it is extremely slow.
I was hoping that more experienced folks could advise me on something that was faster.
What I need to do is to take a list of records on a sheet that contain up to 30 material columns of information (Target and Actual batch weight amounts.) I need to group each of these lines by material into a relative time bucket (12:00 AM to 12:59 AM, 1:00 AM to 1:59 AM, etc.) The user can of course select with Time Bucket they want to view
I am using the sumifs function with two critieria ( i.e. Time >=12:00 and Time < 1:00 ) to get the hourly buckets.
You can also see from this code that I have to count the number of lines for the data and each criteria value because I could not figure out how to set the range of "B" & "C" without counting. Since I am using a filter, I know that the ranges (from a row perspective) of A,B & C are the same, just the relative columns are different. I tried to use the offset function, (i.e. Range(B) = Range(A).Offset(-1,0).Select or B = A.offset(-1,0).Select but they failed for some reason, and no error messages either. I think I somehow turned the erroring off.
Anyway, long story, really could use some help. Here is the related code:
Function Vis(Rin As Range) As Range
'Returns the subset of Rin that is visible
Dim Cell As Range
'Application.Volatile
Set Vis = Nothing
For Each Cell In Rin
If Not (Cell.EntireRow.Hidden Or Cell.EntireColumn.Hidden) Then
If Vis Is Nothing Then
Set Vis = Cell
Else
Set Vis = Union(Vis, Cell)
End If
End If
Next Cell
End Function
Function SUMIFv(Rin As Range, CriteriaRange1 As Range, CriteriaValue1 As Variant, CriteriaRange2 As Range, CriteriaValue2 As Variant) As Long
'Same as Excel SUMIFS worksheet function, except does not count
'cells that are hidden
Dim A1() As Range
Dim B1() As Range
Dim C1() As Range
Dim Csum As Long
' First count up the number of ranges
Cnt = 0
For Each A In Vis(Rin).Areas
Cnt = Cnt + 1
Next A
ReDim A1(1 To Cnt)
ReDim B1(1 To Cnt)
ReDim C1(1 To Cnt)
CntA = 1
For Each A In Vis(Rin).Areas
Set A1(CntA) = A
CntA = CntA + 1
Next A
CntB = 1
For Each B In Vis(CriteriaRange1).Areas
Set B1(CntB) = B
CntB = CntB + 1
Next B
CntC = 1
For Each C In Vis(CriteriaRange2).Areas
Set C1(CntC) = C
CntC = CntC + 1
Next C
If CntA <> CntB Or CntB <> CntC Then
MsgBox ("Error in Sumifs Function: Counts from Ranges are not the same")
End If
Csum = 0
For Cnt = 1 To CntA - 1
Csum = Csum + WorksheetFunction.SumIfs(A1(Cnt), B1(Cnt), CriteriaValue1, C1(Cnt), CriteriaValue2)
Next
SUMIFv = Csum
End Function
((countifv visible cells only
If you are interested, here is a more general COUNTIF solution, and one that you can also apply to SUM and other functions that operate on ranges of cells.
This COUNTIFv UDF uses the worksheet function COUNTIF to count visible cells only, so the Condition argument works the same as with COUNTIF. So you can use it just as you would COUNTIF:
=COUNTIFv(A1:A100,1)
Note that it uses a helper function (Vis) that returns the disjoint range of visible cells in a given range. This can be used with other worksheet functions to cause them to operate only on the visible cells. For example,
=SUM(Vis(A1:A100))
yields the sum of the visible cells in A1:A100. The reason why this approach of using Vis directly in the argument list does not work with COUNTIF is that COUNTIF will not accept a disjoint range as an input, whereas SUM will.
Here's the UDF code:
Function Vis(Rin As Range) As Range
'Returns the subset of Rin that is visible
Dim Cell As Range
Application.Volatile
Set Vis = Nothing
For Each Cell In Rin
If Not (Cell.EntireRow.Hidden Or Cell.EntireColumn.Hidden) Then
If Vis Is Nothing Then
Set Vis = Cell
Else
Set Vis = Union(Vis, Cell)
End If
End If
Next Cell
End Function
Function COUNTIFv(Rin As Range, Condition As Variant) As Long
'Same as Excel COUNTIF worksheet function, except does not count
'cells that are hidden
Dim A As Range
Dim Csum As Long
Csum = 0
For Each A In Vis(Rin).Areas
Csum = Csum + WorksheetFunction.CountIf(A, Condition)
Next A
COUNTIFv = Csum
End Function ))
this both are countif and sumifs with visible cells but i need sumif not sumifs please edit the 2nd code and compile and post the correct program :)

I don't think this is correct...
......................................using DSUM and/or SUBTOTAL, but
these functions don't exclude non-visible (Filtered) lines in a list.
The behaviour for SUBTOTAL is different for "filtered" and "hidden" rows.
This is from the excel help:
For the function_num constants from 1 to 11, the SUBTOTAL function
includes the values of rows hidden by the Hide Rows command under the
Hide & Unhide submenu of the Format command in the Cells group on the
Home tab in the Excel desktop application. Use these constants when
you want to subtotal hidden and nonhidden numbers in a list. For the
function_Num constants from 101 to 111, the SUBTOTAL function ignores
values of rows hidden by the Hide Rows command. Use these constants
when you want to subtotal only nonhidden numbers in a list.
The SUBTOTAL function ignores any rows that are not included in the
result of a filter, no matter which function_num value you use.

Related

How to extract records from a worksheet into a seperate worksheet using VLOOKUPS and IF's

Worksheet1:
Excel sheet
New
Worksheet 1 has licences with 6 columns of information - two being the start and end date.
I need a method of extracting all the records that are within 90 days before the expiry date- the idea being I want a separate alert page
I have done a IF statement that is on the end of the columns that just prints 1 if date is hits the alert criteria or 0 if not...The idea now in Worksheet2 I need some sort of VLOOKUP and IF to extract those records automatically.
How would I do this?
=IF(IFERROR(DATEDIF(TODAY(),H5,"d"),91)<90,1,0)
While use of Pivot table or VBA macro is recommended in such cases, if you absolutely need to use the formula then you may use the below trick.
You already have the Binary column. Now, add another column say Cumulative Binary that will sum all the 1's till the current row using a SumIf formula as shown in the screenshot below (it is fine if some numbers are repeated because of 0's)
The formula in I3 in my workbook is
=SUMIF(H$3:H3,1,H$3:H3)
and you may adjust it as per your needs.
Now, it is easy since each row has a unique number, we could use Vlookup or like I have done here i.e. use Offset function which simply matches the value in the "Lookup Column" to the value in "Cumulative Binary" column and returns the rows that match.
=IFERROR(OFFSET($F$2,MATCH(M3,$I$3:$I$9,0),0,1,2),"")
Please note that it is an array formula as I need to return multiple columns (2 here). So, I selected two columns N,O as shown in the screenshot wrote the formula and used Ctrl+Shift+Enter (instead of Enter). Then I simply dragged the formula down. You may want to adjust it as per your needs by including more columns.
If you can use VBA, you may write some code like this:
Option Explicit
Public Sub CopyCloseToExpiration()
Dim rngSource As Range: Set rngSource = ThisWorkbook.Worksheets("Sheet1").Cells(2, 1).Resize(LastRow(ThisWorkbook.Worksheets("Sheet1")) - 1, 9)
Dim rngDestinationTopLeft As Range: Set rngDestinationTopLeft = ThisWorkbook.Worksheets("Sheet2").Cells(LastRow(ThisWorkbook.Worksheets("Sheet2")) + 1, 1)
Dim datLimit As Date: datLimit = DateAdd("d", 90, Date)
CopyBeforeDate rngSource, rngDestinationTopLeft, datLimit
End Sub
Public Sub CopyBeforeDate(rngSource As Range, rngDestinationTopLeft As Range, datLimit As Date)
Dim lngOffset As Long: lngOffset = 0
Dim rngRow As Range: For Each rngRow In rngSource.Rows
If rngRow.Cells(1, 8).Value < datLimit Then
rngDestinationTopLeft.offset(lngOffset, 0).Resize(rngRow.Rows.Count, rngRow.Columns.Count).Value = rngRow.Value
lngOffset = lngOffset + 1
End If
Next
End Sub
Public Function LastRow(ewsSheet) As Long
With ewsSheet
Dim lngResult As Long: lngResult = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
LastRow = lngResult
End Function
You have to put the above into a new Module, customize it (e.g. replace "Sheet1" with the name of you worksheet's actual name), and run it (You can place the caret on the sub CopyCloseToExpiration and hit F5 or place a button somewhere and call this function from its event handler).

Dynamic Summing Range

Currently I have a medical spread-sheet with a list of clients that we have serviced. We have 8 different clinical categories which are denoted by different acronyms - HV,SV,CV,WV,CC,OV,TS and GS.
A client can receive multiple therapies i.e. HV,SV,CV - in the background we have a counter mechanism which would increment each of these records by 1.The formula used for this counter is:
=(LEN('Parent Sheet'!F25)-LEN(SUBSTITUTE('Parent Sheet'!F25,'Parent Sheet'!$P$4,"")))/LEN('Parent Sheet'!$P$4)
At the bottom of the sheet we then have a sum which ads up all the treatments that occurred for that week.
Now the tricky part about this is that we have almost a year's worth of data in this sheet but the summing formulas are set as: SUM(COLUMN 6: COLUMN 53) but due to a need to increase the entries beyond this limit, we have to adjust the sum formula. We have 300 SUM Formulas adding up each of the 8 Criteria items and assigning them to the HV,SV,SC,WV etc. counters.
Would we have to adjust this manually one by one or is there a easier way of doing this?
Thank you very much!
To me, I think you should change the sheet layout a little, create a User Defined Function (UDF) and alter the formulas in your Sum rows for efficient row/column adding (to make use of Excel's formula fill). The only issue is that you need to save this as a Macro-Enabled file.
What you need to change in the formulas is to utilize $ to restrict changes in column and rows when the formula fill takes place.
To illustrate in an example, consider:
Assuming the first data starts at row 6, and no more than row 15 (you can use the idea of another data gap on the top). Alter the Sum row titles to begin with the abbreviation then create a UDF like below:
Option Explicit
' The oRngType refers to a cell where the abbreviation is stored
' The oRngCount refers to cells that the abbreviation is to be counted
' Say "HV" is stored in $C16, and the cells to count for HV is D$6:D$15,
' then the sum of HV for that date (D16) is calculated by formula
' `=CountType($C16, D$6:D$15)`
Function CountType(ByRef oRngType As Range, ByRef oRngCount) As Long
Dim oRngVal As Variant, oVal As Variant, oTmp As Variant, sLookFor As String, count As Long
sLookFor = Left(oRngType.Value, 2)
oRngVal = oRngCount.Value ' Load all the values onto memory
count = 0
For Each oVal In oRngVal
If Not IsEmpty(oVal) Then
For Each oTmp In Split(oVal, ",")
If InStr(1, oTmp, sLookFor, vbTextCompare) > 0 Then count = count + 1
Next
End If
Next
CountType = count
End Function
Formulas in the sheet:
Columns to sum are fixed to rows 6 to 15 and Type to lookup is fixed to Column C
D16 | =CountType($C16,D$6:D$15)
D17 | =CountType($C17,D$6:D$15)
...
E16 | =CountType($C16,E$6:E$15)
E17 | =CountType($C17,E$6:E$15)
The way I created the UDF is to lookup and count appearances of a cell value (first argument) within a range of cells (second argument). So you can use it to count a type of treatment for a big range of cells (column G).
Now if you add many columns after F, you just need to use the AutoFill and the appropriate rows and columns will be there.
You can also create another VBA Sub to add rows and columns and formulas for you, but that's a different question.
It's isn't a great idea to have 300 sum formulas.
Name your data range and include that inside the SUM formula. So each time the NAMED data range expands, the sum gets calculated based on that. Here's how to create a dynamic named rnage.
Sorry I just saw your comment. Following is a simple/crude VBA snippet.
Range("B3:F12") is rangeValue; Range("C18") is rngTotal.
Option Explicit
Sub SumAll()
Dim WS As Worksheet
Dim rngSum As Range
Dim rngData As Range
Dim rowCount As Integer
Dim colCount As Integer
Dim i As Integer
Dim varSum As Variant
'assuming that your said mechanism increases the data range by 1 row
Set WS = ThisWorkbook.Sheets("Sheet2")
Set rngData = WS.Range("valueRange")
Set rngSum = WS.Range("rngTotal")
colCount = rngData.Columns.Count
'to take the newly added row (by your internal mechanism) into consideration
rowCount = rngData.Rows.Count + 1
ReDim varSum(0 To colCount)
For i = 0 To UBound(varSum, 1)
varSum(i) = Application.Sum(rngData.Resize(rowCount, 1).Offset(, i))
Next i
'transpose variant array with totals to sheet range
rngSum.Resize(colCount, 1).Value = Application.Transpose(varSum)
'release objects in the memory
Set rngSum = Nothing
Set rngData = Nothing
Set WS = Nothing
Set varSum = Nothing
End Sub
Screen:
You can use named ranges as suggested by bonCodigo or you could use find and replace or you can insert the columns within the data range and Excel will update the formula for you automatically.

Logarithmic averaging preset function in excel - using ranges as input values

I need to add my own function for logarithmic averaging to excel but i'm not sure how to have a range of values as an input value or how to make count the number of values in a given range.
I have a small amount of experience with programming.
The formula i usually use in excel and am looking to implement as a pre-set function is the following:
=10*LOG(SUM(10^('range of values'/10)/'number of values in the range'))
Can anyone help me out?
You can try this, you may need to adjust to account for blank cells or non-text in the range
Function TestUDF(rngValues As Range) As Double
Dim lSumofValues As Long
Dim lCountofValues As Long
Dim rngLoop As Range
lSumofValues = 0
lCountofValues = rngValues.Count 'Get count of values in items in range
'Add up the values in the range
For Each rngLoop In rngValues
lSumofValues = lSumofValues + rngLoop.Value
Next
'Perform Calculation
TestUDF = 10 * Log((10 ^ (lSumofValues / 10) / lCountofValues))
End Function
And then simply enter =TestUDF(A1:A18) in a cell to use it.

Counting cells based on their colour and other criteria

I'm working on some rostering functions in Excel, with the basis being that we have a limited number of people that will need to be rostered-on for work, covering shifts at multiple sites
When planning the rosters, we use a simple set of coloured cells to fill-in for when people are on dayshift, nightshift, not-rostered, annual leave, etc. Given that there are multiple sites we plan for I need to have a quick formula that checks whether that individual has been rostered-on for simultaneous shifts at multiple sites (obviously not possible), so we can easily identify when there is a conflict in the planning stage. The formula needs to return a TRUE, or value (eg. count >1 means more than one assignment for that person) so that I can use either conditional formatting or VBA to highlight a cell/the row and draw attention to the conflict
What I've tried doing is summing/counting cells that are coloured with a few VBA methods:
Function ISFILLED(MyCell As Range)
If MyCell.Interior.colorIndex > 0 Then
Result = True
Else
Result = False
End If
ISFILLED = Result
End Function
and/or:
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
These both work fine on their own but I'm unable to combine this with a SUMIFS/COUNTIFS style function to only count the number of cells that are coloured when that individual's name appears against that assignment.
If you have a look in the sample image from the roster, you can see that Joe Bloggs 4 has been assigned a shift at both Site 1 and Site 2 on the 21/05/2014. What I'm after is essentially to count number of coloured cells on row, if the individuals name matching the criteria is against those cells. For this example if would be
=COUNTIFS(C8:AQ8, "Joe Bloggs 4", C12:AQ12, *Cell is Coloured*)
Colour of the cell doesn't matter (hence the first function ISFILLED is better as i don't need a reference cell for the fill), as it's just a sense-check.
Appreciate any help/pointers, as it is, I'm stuck!
You won't be able to use SUMIFS and COUNTIFS for this. You need something along these lines:
Function IsFilledArr(rng As Range) As Variant
Dim i As Long, j As Long
Dim v As Variant
ReDim v(1 To rng.Rows.Count, 1 To rng.Columns.Count)
For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count
v(i, j) = rng.Cells(i, j).Interior.ColorIndex > 0
Next j
Next i
IsFilledArr = v
End Function
This UDF can be called as an array formula, i.e. select a range of cells, type the formula in the top-left cell (while the whole range is still selected), and then press Ctrl-Shift-Enter. Then you can operate on the returned array, e.g. SUM it.
Example usage:
where the -- double minus converts Boolean TRUE/FALSE values (which are not summable) into 1's and 0's (which are).
I'll let you adapt this to suit your particular requirements.
EDIT: You want more:
calculate the number of filled cells in column C, where there was an adjacent filled cell in column B - in this case C4 would be the only cell that met that criteria.
This formula will do the trick (entered as an array formula):
=SUM(IF(IsFilledArr(B2:B7)+IsFilledArr(C2:C7)>1,1))
Note the use of SUM(IF(...,1)) to mimic COUNT. That is the way to do it when you're dealing with array formulas.
Read more here: http://www.cpearson.com/excel/ArrayFormulas.aspx
You asked for help/pointers; this should hopefully be more than enough to get you unstuck. You can adapt this approach to meet whatever you exact needs are.

Excel Lookup return multiple values horizontally while removing duplicates

I would like to do a vertical lookup for a list of lookup values and then have multiple values returned into columns for each lookup value. I actually managed to do this after a long Google search, this is the code:
=INDEX(Data!$H$3:$H$70000, SMALL(IF($B3=Data!$J$3:$J$70000, ROW(Data!$J$3:$J$70000)-MIN(ROW(Data!$J$3:$J$70000))+1, ""), COLUMN(A$2)))
Now, my problem is, as you can see in the formula, my lookup range contains 70,000 rows, which means a lot of return values. But most of these return values are double. This means I have to drag above formula over many columns until all lookup values (roughly 200) return #NUM!.
Is there any possible way, I guess VBA is necessary, to return the values after duplicates have been removed? I'm new at VBA and I am not sure how to go about this. Also it takes forever to calculate having so many cells.
[Edited]
You can do what you want with a revised formula, not sure how efficient it will be with 70,000 rows, though.
Use this formula for the first match
=IFERROR(INDEX(Data!$H3:$H70000,MATCH($B3,Data!$J3:$J70000,0)),"")
Now assuming that formula in in F5 use this formula in G5 confirmed with CTRL+SHIFT+ENTER and copied across
=IFERROR(INDEX(Data!$H3:$H70000,MATCH(1,($B3=Data!$J3:$J70000)*ISNA(MATCH(Data!$H3:$H70000,$F5:F5,0)),0)),"")
changed the bolded part depending on location of formula 1
This will give you a list without repeats.....and when you run out of values you get blanks rather than an error
Not sure if you're still after a VBA answer but this should do the job - takes about 25 seconds to run on my machine - it could probably be accelerated by the guys on this forum:
Sub ReturnValues()
Dim rnSearch As Range, rnLookup As Range, rnTemp As Range Dim varArray
As Variant Dim lnIndex As Long Dim strTemp As String
Set rnSearch = Sheet1.Range("A1:A200") 'Set this to your 200 row value range
Set rnLookup = Sheet2.Range("A1:B70000") 'Set this to your lookup range (assume 2
columns)
varArray = rnLookup
For Each rnTemp In rnSearch
For lnIndex = LBound(varArray, 1) To UBound(varArray, 1)
strTemp = rnTemp.Value
If varArray(lnIndex, 1) = strTemp Then
If WorksheetFunction.CountIf(rnTemp.EntireRow, varArray(lnIndex, 2)) = 0 Then 'Check if value exists already
Sheet1.Cells(rnTemp.Row, rnTemp.EntireRow.Columns.Count).End(xlToLeft).Offset(0, 1).Value =
varArray(lnIndex, 2)
End If
End If
Next Next
End Sub

Resources