Count merged cells that have substring - excel

I have some code by a former coworker that counts merged cells with a particular string. For example, if there was a merged cell with size 3 with the name "Youtube" on it, it would return 3.
This is the function in question:
Function MergedCellsCount(rRange As Range, crit As Variant) As Double
Application.Volatile
MergedCellsCount = 0 'in case there are no matches
For Each c In rRange
If LCase(c.Value) = LCase(crit) Then
MergedCellsCount = MergedCellsCount + c.MergeArea.Cells.Count
prev_rng = c.MergeArea.Address
End If
Next
' MergedCellsCount = MergedCellsCount / 5
End Function
But now, i want to count the cells that have a substring within that string.
If for example there was a merged cell with size 3 with "Youtube | Spotify", I want to know how to change that function to search for the substring "Youtube".
Any suggestions on how to achieve this?
Thanks in advance!

Count Cells Containing a String (Merged Cells) (UDF)
Note that if you merge or unmerge cells within the Criteria Range, the cells count will not be updated until the next recalculation of the worksheet.
To trigger recalculation, a nice 'trick' is to autofit a column by double clicking the right border of its column header (e.g. for column A, the short line between A and B).
The Code
Option Explicit
Function MergedCellsCount(CriteriaRange As Range, _
Criteria As String) _
As Long
Application.Volatile
Dim c As Range
For Each c In CriteriaRange.Cells
If Not IsError(c) Then
If InStr(1, c.Value, Criteria, vbTextCompare) > 0 Then
MergedCellsCount = MergedCellsCount + c.MergeArea.Cells.Count
End If
End If
Next
End Function

Related

Is there a function for finding "ends with"

Is there a function to find from entries in a column that ends with ".5" using vba?
I have a live feed that I take from a html page, in values in column B are float numbers and I want to know if I can use a VBA function to find out how many values are ending with 0.5
Well without VBA:
=SUMPRODUCT(--(RIGHT(B1:B23,2)=".5"))
and with vba, then:
Sub dural()
MsgBox Evaluate("SUMPRODUCT(--(RIGHT(B1:B23,2)="".5""))")
End Sub
EDIT#1:
The worksheet formula treats column B like Strings. and counts how many in column B end with .5. This is expressed as an array of 0/1 by the expression within the --().
SUMPRODUCT() just adds up this array.
And with VBA, as a user-defined function (UDF):
Public Function CountThePointFive(ByRef theArea As Range) As Long
Dim count As Long
Dim cell As Variant
For Each cell In theArea
Dim value As String
value = CStr(cell.value)
Dim integerPart As Long
integerPart = CLng(Left$(CStr(value), Len(value) - InStr(1, value, ".")))
If (cell.value - integerPart) = 0.5 Then
count = count + 1
End If
Next cell
CountThePointFive = count
End Function

trying to check if a cell value exists (duplicated) in a non contiguous row, where some columns might be hidden

am working on sheet and using the vba for the first time and i love it. but been stuck in one thing for the last few days, after all the reading and searching can not figure how to do this part, here is the scenario I have:
locked sheet and workbook, user can only edit/entre values (numbers) in cells C8:G8 and I8:X8, column H always blank and host no value.
the user is able to hide columns in C8:G8 and I8:X8 if he need to use certain number of columns.
trying to set a macro to identify if a value has been entered more then once within the entire range C8:X8 (excluding H it is empty and any other columns if hidden)
I started with countif and give the perfect results only if all columns are visible:
Sub dup()
Application.EnableEvents = False
Dim x As Variant 'tried with range
Dim n As Variant 'tried with range
Dim rng1 As Range 'tried with variant
Set rng1 = Range("C8:X8")
For Each x In rng1.SpecialCells(xlCellTypeVisible)
If Application.WorksheetFunction.CountIf(rng1, x) > 1 Then
x.Offset(4) = "3" 'used for conditional formatting
Else
x.Offset(4) = "10" 'used for conditional formatting
End If
Next
Application.EnableEvents = True
End Sub
still work when some columns are hidden but it does check through hidden columns and this is not what i want (i want it to skip hidden columns)
some search and reading find out the countif is unable to get the cell property if visible or hidden. tried both options application.countif and application.worksheetfunction.countif
so tried application.match but no luck
For Each x In rng1
If Not IsEmpty(x) Then
n = Application.match(x.Value, rng1.Value, 0)
If Not IsError(n) Then
x.Offset(4) = "3"
Else
x.Offset(4) = "10"
End If
End If
Next
tried application.hlookup and not able to get the desired result :
For Each x In rng1
If Not IsEmpty(x) Then
n = Application.HLookup(x.Value, rng1.Value, 1, False)
If Not IsError(n) Then
x.Offset(4) = "3"
Else
x.Offset(4) = "10"
End If
End If
Next
it will match the cell itself and look only in the first part of the range C8:G8.
just to explain about the hidden columns situation, the user can hide/show 1,2,3,4 and 5 columns in the first range (if user select 2, only columns C8:D8 will be visible) same apply for range I8:X8, if user select 5 only I8:M8 will be visible) so there will be a case where a hidden column will be in between visible columns.
find few answers on how to use SumProduct(subtotal,...) as a formula only and could not covert it to a VBA.
any recommendation and advise will be appreciated.
Please try this solution.
Sub Dup()
Const Sep As String = "|" ' select a character that
' doesn't occur in Rng
Dim Rng As Range
Dim Arr As Variant
Dim SearchString As String
Dim n As Integer
Dim i As Integer
' needed only if you have event procedures in your project:-
Application.EnableEvents = False
Set Rng = Range("C8:X8")
Arr = Rng.Value
SearchString = Sep
For i = 1 To UBound(Arr, 2)
If Not Columns(Rng.Cells(i).Column).Hidden Then
SearchString = SearchString & Arr(1, i) & Sep
End If
Next i
For i = 1 To UBound(Arr, 2)
' skip blanks, incl. column H, & hidden cells
If (Not Columns(Rng.Cells(i).Column).Hidden) And (Len(Arr(1, i)) > 0) Then
n = InStr(SearchString, Sep & Arr(1, i) & Sep)
n = InStr(n + 1, SearchString, Sep & Arr(1, i) & Sep)
With Rng.Cells(i)
If .Column <> 8 Then ' skip column H
.Offset(4).Value = IIf(n > 0, 3, 10)
' Note that "3" is a string (text) whereas 3 is a number
' It's unusual to enter a number as text because it's use
' for calculations is greatly impaired.
' However, you may modify the above line to write strings
' instead of numbers.
End If
End With
End If
Next i
Application.EnableEvents = True
End Sub
The sub assigns all non-hidden values in the Range to to an array and then reads them into a string (SearchString) in which they are separated by a special character which can be re-defined. All values exist in this string at least once. The second loop looks for the existing value which must be both followed and preceded by the special character because "a" would be found in "ab", "a|" in "ba|" but "|a|" is unambiguous. Then a second search (Instr), starting from after where the first match was found, determines if a duplicate exists. The Iif function then sets the value in the cell 4 rows below the examined cell. Note that the array index is identical to the cell number in the range because of the way the array was created.
Since the Instr function will "find" a null string in position 1 and consider it a duplication by default, null strings aren't processed, not setting any number for the purpose of CF. Column H should therefore be omitted. However, if column H should have any value the CF number will still not be written.
As the sub is called by an event procedure the Application's EnableEvents property should be set in that procedure, not in the sub. This is for greater clarity of the code and has no bearing on the functionality unless the vent procedure also calls other procs.
#Variatus, Sorry to get back on this, after further tests i think i found an issue, if i try to hide any clomun from range C8:G8 (ex : G8 and let say it has same value as M8) the Arr will only look through C8:F8 only, for some reason it doesn't go all the way to X8, and it will mark M8 as duplicate.
or even if the duplicate value is withing I8:X8 it wont find it because the Arr stop at the first hidden cell from the first range
any advise will be appreciated

excel COUNTIF Count Words with a Cell Background Option

Is it possible to use the CountIf function with advanced options: count cells containing a specific string only if the cell background is of a specific color.
I'm using the Excel formula: `=COUNTIF(page001!B:B;"id-p01"), but blocks of data on each sheet have unique strings, each block could have two different background colors: GREEN or BLUE. So what i'm asking is if i can get a function which would e.g. COUNT cells containing "id-p01" on a selected sheet, but ONLY those with a GREEN background color.
Here is an example of how the sheet looks like:
With this formula: =COUNTIF(page001!B:B;"*id-p01*")
It counts id-p01 on the selected sheet in the B:B column.
Is it possible to make it count only GREEN background colored cells?
This quick solution will print out on the screen the number of cells within the Range B1 to B1000 (you can modify the Range if you've more/less rows to test) that have exactly your green color.
Note that you have to use a macro to do this, it can't be achieved with a simple formula.
To create a macro, press ALT + F11, then right-click on your Workbook's name and "Insert Module". Copy paste the code below and press F5 while you're still in the VBA window or use any other method to run the macro.
Sub CountWithColor()
For Each c In Range("B1:B1000")
If c.Value Like "*id-p01*" And c.Interior.Color = RGB(226, 239, 218) Then
compteur = compteur + 1
End If
Next c
MsgBox (compteur)
End Sub
Let me know if this helped.
Eleove
Count If Value And Color
Function CIVAC(Range As Range, Value As Variant, _
Optional ColorIndex As Long = -4142, _
Optional Compare As Integer = 1) As Long
'Title
'Count If Value And Color
'Description
'In a specified contiguous range, counts the number of cells both,
'containing a specified value and having a specified Interior ColorIndex.
Dim arrVal As Variant 'Range Array
Dim arrClr() As Long 'ColorIndex Array
Dim lngVal As Long 'Row Counter
Dim iVal As Integer 'Column Counter
Dim lngResult As Long 'Result Accumulator
'Values
arrVal = Range.Areas(1) 'Prevent Multiple Areas Error
'ColorIndexes
ReDim arrClr(LBound(arrVal) To UBound(arrVal), _
LBound(arrVal, 2) To UBound(arrVal, 2))
For lngVal = LBound(arrClr) To UBound(arrClr)
For iVal = LBound(arrClr, 2) To UBound(arrClr, 2)
arrClr(lngVal, iVal) = Range.Cells(lngVal, iVal).Interior.ColorIndex
Next
Next
'Count
For lngVal = LBound(arrClr) To UBound(arrClr)
For iVal = LBound(arrClr, 2) To UBound(arrClr, 2)
If Not IsError(arrVal(lngVal, iVal)) Then 'Prevent VBA Errors
If InStr(1, arrVal(lngVal, iVal), Value, Compare) <> 0 And _
arrClr(lngVal, iVal) = ColorIndex Then lngResult = lngResult + 1
End If
Next
Next
CIVAC = lngResult
End Function
That's nice, but what's the 'Interior ColorIndex' of the color in this cell?
Cell Interior Color Index
Function CICI(CellRange As Range) As Long
'Title
'Cell Interior Color Index
'Description
'Returns the Interior ColorIndex of a specified cell ('CellRange').
'If 'CellRange' contains more than one cell, it uses the first cell.
CICI = CellRange(1, 1).Interior.ColorIndex
End Function

How to trigger count of colored cells using text match in another column

I want to match the employee name on sheet one against employee names in sheet two, then run a count of all yellow-colored (filled) cells in a particular column.
I have a VBA module that will run the count of highlighted cells without doing a name match and it works perfectly. Now I need to add in an additional metric of running a count of all highlighted cells for each employee.
Data Info:
Sheet One B2:B50 - list of employee last names.
Sheet Two D2:D1845 - column with employee last names. Note: This is a worksheet with 1845 line items of client data records and therefore the employee name could be listed numerous times in said column.
Sheet Two E2:E1845 - column with yellow-colored cells. Not all cells in the column are colored yellow. Which is why I need a count of how many are colored for each employee.
Count by color VBA that works:
Function CountByColor(InputRange As Range, ColorRange As Range) As Long
Dim cl As Range, TmpCount As Long, ColorIndex As Integer
Application.Volatile
ColorIndex = ColorRange.Interior.ColorIndex
TmpCount = 0
On Error Resume Next
For Each cl In InputRange.Cells
If cl.Interior.ColorIndex = ColorIndex _
Then TmpCount = TmpCount + 1
Next cl
CountByColor = TmpCount
End Function
Based on what you explained to me you want in the comments here's a one-liner to do what you want:
Public Sub NameColorCount(NameToSearch As String, TargetCell As Range, _
SearchRange As Range, RangeToCountColor As Range, ColorRange As Range)
If Not SearchRange.Find(NameToSearch) Is Nothing Then
TargetCell.Value = CountByColor(RangeToCountColor, ColorRange)
End If
End Sub
If you want to do this in a cell you can use CountByColor as a UDF and use the following formula:
=IF(COUNTIF(D:D, B1)>0,CountByColor(E:E, B1),"")
Assuming your ColorRange is the 'B' cell, modify otherwise
I'm not really sure if this is what you want to achieve I can't post images yet.
This Sub insert a counter in range Sheet1 C2:C50 for every employee who is in Sheet2 D2:D1845 and the cell next to is yellow colored.
Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant, CountA As Integer
Set EmployeeRange = Worksheets("Sheet1").Range("B2:B50")
Set CompareRange = Worksheets("Sheet2").Range("D2:D1845")
For Each x In EmployeeRange
For Each y In CompareRange
If x = y And y.Offset(0, 1).Interior.ColorIndex = 6 Then CountA = CountA + 1
Next y
x.Offset(0, 1).Value = CountA
CountA = 0
Next x
End Sub

Excel MAXIF function or emulation?

I have a moderately sized dataset in excel from which I wish to extract the maximum value of the values in Column B, but those that correspond only to cells in Column A that satisfy certain criteria.
The desired functionality is similar to that of SUMIF or COUNTIF, but neither of those return data that is necessary. There isn't a MAXIF function; how do I emulate one?
You can use an array formula.In the cell in which you want the max calculated enter: =Max(If([test],[if true],[if false]) where you replace the values in square brackets with the test, what to return if true and what to return if false. For example:
=MAX(IF(MOD(A2:A25,2)=0,A2:A25,0)
In this formula I return the value in column A if the value divided by 2 has no remainder. Notice that I use a range of cells in my comparison and in the value if false rather than a single cell.
Now, while still editing the cell, hit Ctrl+Shift+Enter (hold down the Ctrl key and the Shift together and then hit enter).
This creates an array formula that acts on each value in the range.
EDIT BTW, did you want to do this programmatically or manually? If programmatically, then what environment are you using? VBA? C#?
EDIT If via VBA, you need to use the FormulaArray property and R1C1 references like so:
Range("A1").Select
Selection.FormulaArray = "=MAX(IF(MOD(R[1]C:R[24]C,2)=0,R[1]C:R[24]C,0))"
Array formulas don't work very well when you want to use dynamic or named ranges (e.g., "the maximum amount due for rows above the current row that have the same counterparty as the current row). If you don't want to use an array formula, you can always resort to VBA to do something like this:
Function maxIfs(maxRange As Range, criteriaRange As Range, criterion As Variant) As Variant
maxIfs = Empty
For i = 1 To maxRange.Cells.Count
If criteriaRange.Cells(i).Value = criterion Then
If maxIfs = Empty Then
maxIfs = maxRange.Cells(i).Value
Else
maxIfs = Application.WorksheetFunction.Max(maxIfs, maxRange.Cells(i).Value)
End If
End If
Next
End Function
A limitation with the code provided thus far is that you are restricted to 2 conditions. I decided to take this code further to not restrict the number of conditions for the MaxIfs function. Please see the code here:
Function MaxIfs(MaxRange As Range, ParamArray Criteria() As Variant) As Variant
Dim n As Long
Dim i As Long
Dim c As Long
Dim f As Boolean
Dim w() As Long
Dim k As Long
Dim z As Variant
'Error if less than 1 criteria
On Error GoTo ErrHandler
n = UBound(Criteria)
If n < 1 Then
'too few criteria
GoTo ErrHandler
End If
'Define k
k = 0
'Loop through cells of max range
For i = 1 To MaxRange.Count
'Start by assuming there is a match
f = True
'Loop through conditions
For c = 0 To n - 1 Step 2
'Does cell in criteria range match condition?
If Criteria(c).Cells(i).Value <> Criteria(c + 1) Then
f = False
End If
Next c
'Define z
z = MaxRange
'Were all criteria satisfied?
If f Then
k = k + 1
ReDim Preserve w(k)
w(k) = z(i, 1)
End If
Next i
MaxIfs = Application.Max(w)
Exit Function
ErrHandler:
MaxIfs = CVErr(xlErrValue)
End Function
This code allows 1 to multiple conditions.
This code was developed with reference to multiple code posted by Hans V over at Eileen's Lounge.
Happy coding
Diedrich

Resources