Hi I am a beginner in excel so please bear with my ignorance.
Lately i found myself in need of a function that counts the number of words in a range of cells (counting the empty cells as 0, of course).
Surfing the net i found this simple VBA code:
Function intWordCount(rng As Range) As Integer
intWordCount = UBound(Split(Application.WorksheetFunction.Trim(rng.Value), " "), 1) + 1
End Function
I found this extremly useful as i could just use
=intwordcount(A2)+intwordcount(B2)+intwordcount(C2)
in excel function bar to sum the number of words contained in 3 cells without counting the empty ones.
The problem is that i now need to do this on a large range of cells in a column and simply using
=intwordcount(A2:A18)
does not work.
I think the error is that it tries to apply the function on the range considering it as a single big cell whereas i want it to apply the function to every single cell in the range and sum every output to obtain the total.
I'd be really grateful if someone could help me cause i can't figure out a solution.
I'm using Excel 2016.
Thank you very much for your assistance.
Loop through the cells and apply the same logic.
The function will now work for single-cell ranges & multi-cell ranges
Function intWordCount(rng As Range) As Integer
Dim MyCell as Range
For Each MyCell in rng
intWordCount = intWordCount + UBound(Split(Application.WorksheetFunction.Trim(MyCell.Value), " "), 1) + 1
Next MyCell
End Function
If you have a recent version of Excel:
Function intWordCount(rng As Range) As Long
Dim wf As WorksheetFunction, s As String
Set wf = Application.WorksheetFunction
s = wf.TextJoin(" ", True, rng)
intWordCount = UBound(Split(wf.Trim(s), " "), 1) + 1
End Function
Related
I have four columns
I want to find all combinations of numbers from each column that add up to an exact value. Is there a VBA script that can help me achieve this goal?
I am looking for an output like:
Let's say that I want the values to add up to 2721, then the code should return the combination as (1,3,6,7) i.e. the corresponding row of each column and so on until it finds all such combinations. If it is not able to find the exact sum then find the nearest sum to that value.
It can be easily done in VBA using ReSize method, Sum function, Loops and conditional statements. Below is an exampe with sample data as:
Step 1: Write a VBA Macro similar to this.
Option Explicit
Function Check_Combination_Sum(ByVal lngSum As Long) As String
Dim rng As Range
Dim rngSource As Range
Set rngSource = Range("A2:A16")
For Each rng In rngSource.Cells
If WorksheetFunction.Sum(rng.Resize(1, 4)) = lngSum Then
rng.Resize(1, 4).Interior.Color = RGB(200, 255, 220)
Check_Combination_Sum = rng.Row & "," & Check_Combination_Sum
End If
Next
If Len(Check_Combination_Sum) > 1 Then
Check_Combination_Sum = Left(Check_Combination_Sum, Len(Check_Combination_Sum) - 1)
End If
End Function
Sub Check_Data()
MsgBox Check_Combination_Sum(197)
End Sub
Step 2: The code above will highlight the rows containing the data with total sum as given and also pop the rows number. Modify the code to suit your requirements.
I have an Excel file populated with a large amount of COUNTIFS functions (above 300). The formulas work fine but I need to be able to find the address for each COUNTIFS result as the data source is very large.
i.e. if COUNTIFs gives me result of 1 for the selected parameters, I need to be able to know which cell/row the function is counting from the data source.
I was thinking this could be done with the ADDRESS function, but I am not sure how this can be used together with COUNTIFS.
I would go with a user-defined function.
Using the below code, you would get this result:
Public Function ListAddresses(SearchTerm As Variant, SearchRange As Range) As String
Dim WS As Worksheet, rCell As Range
Set WS = Sheets(SearchRange.Parent.Name)
SearchTerm = UCase(SearchTerm)
Set SearchRange = Intersect(WS.UsedRange, SearchRange)
For Each rCell In SearchRange.Cells
If UCase(rCell.Value) = SearchTerm Then
ListAddresses = ListAddresses & rCell.Address(False, False) & " | "
End If
Next rCell
If ListAddresses <> "" Then
ListAddresses = Left(ListAddresses, Len(ListAddresses) - 3)
Else
ListAddresses = "<none>"
End If
End Function
Try,
=ADDRESS(AGGREGATE(15, 7, ROW(C$3:INDEX(C:C, MATCH(1E+99, C:C)))/(C$3:INDEX(C:C, MATCH(1E+99, C:C))=1), ROW(1:1)), COLUMN(B:B), 4, 1, "Shett4")
Assuming your criteria rows are aligned, you can find the rows that are going into the count. Referencing the image below, enter this as an array formula (Ctrl+Shift+Enter) in an area with the same number of rows that the COUNTIFS returned (I entered the formula into H2:H4 in the image):
=SMALL(IF(((A2:A11=F1)+(B2:B11=F2)+(C2:C11=F3))=3,ROW(A2:A11)),ROW(INDIRECT("1:"&F4)))
I'm attempting to use a COUNTIF-like function in Excel 2016 to total up a series of cells by their background color... 3 different colors (green, yellow, red) representing 3 different 'states' (first largest, second largest, third largest). I managed to get it working by using this VBA coding:
Function Countcolour(rng As Range, colour As Range) As Long
Dim c As Range
Application.Volatile
For Each c In rng
If c.Interior.ColorIndex = colour.Interior.ColorIndex Then
Countcolour = Countcolour + 1
End If
Next
End Function
However, this particular code doesn't take into account conditional formatting.
So for example, I try to conditionally format a set of data to highlight its first largest value green, second largest yellow, third largest red. I use this VBA function in another block to get a count of all the green highlights. However, it doesn't pick up on the background color of the cell because of the conditional formatting.
I'm sure I'm missing something obvious... I feel like the first part of the If condition should be some form of c.FormatCondition.Interior, but I've tried variations on the theme with no success.
Thanks in advance for any help that can be provided!
This is something many people try to do including me.
There are some useful codes on the internet like http://www.cpearson.com/excel/CFColors.htm
but after searching a lot I found only ONE with the answer
get conditional formatted color with vba in excel and it works!
The solution is easy:
you can use
.cells(1,1).displayformat.interior.color
or
.cells(1,1).displayformat.interior.colorIndex
Example:
Function CountColor(ByRef rng As Range, ByRef color As Long) As Variant
Dim total: total = 0
If (Not (rng Is Nothing)) Then
Dim element As Variant
For Each element In rng
total = total - (element.DisplayFormat.Interior.color = color) ' MINUS because TRUE evaluates to -1
Next element
End If
CountColor = total
End Function
Sub test_countColors()
With Sheet1
Dim rng As Range
Dim color As Long
Dim total As Long
Set rng = Range(.Cells(1, 1), .Cells(3500, 55)) ' Or anay other range
color = 8438015 ' Or any other color
total = CountColor(rng, color)
MsgBox "Total= " & total
End With
End Sub
I wish to categorize my transactions in a way where I can alter the categories on the fly. I think it's easier explained by showing what I have.
I have the following tables
Transactions
A: Date
C: Name
D: Amount
Fast Food List:
L: Name (partial name since going to be doing string search)
I wish to sum the transaction amount based on multiple criteria, such as date and category. Here's a formula that works:
=SUMIFS(D:D,A:A,"*03/2013*",C:C,"*"&L3&"*")
There's one fundamental problem: it only supports ONE item from the Fast Food List. Is there any way I can simply do a text stringth search across the entire Fast Food names?
""&L3&"" to ""&L:L&"" or something?
Here are some things I've tried.
1) Modify the SUMIFS criteria ""&L3&"" with a boolean UDF. The issue I run into here is that I can't figure out how to pass the current Row being looped by SUMIF into the function.
Public Function checkRange(Check As String, R As Range) As Boolean
For Each MyCell In R
If InStr(Check, MyCell.Value) > 0 Then
checkRange = True
End If
Next MyCell
End Function
If I could send Check to this function, well I would be set.
2) Replace the sum_range of the SUMIFS with a UDF that returns the range of rows
Public Function pruneRange(Prune_range As Range, Criteria_range As Range) As Range
Dim Out_R As Range
Dim Str As String
ActiveWorkbook.Sheets("Vancity Trans").Activate
' Loop through the prune_range to make sure it belongs
For Each Cell In Prune_range
' loop through criteria to see if it matches current Cell
For Each MyCell In Criteria_range
If InStr(Cell.Value, MyCell.Value) > 0 Then
' Now append cell to Out_r and exit this foreach
' Str = Str & Cell.Address() & ","
Str = Str & "D" & Cell.Row() & ","
Exit For
End If
Next MyCell
Next Cell
' remove last comma form str
Str = Left(Str, Len(Str) - 1)
' use str to set the range
Set Out_R = Range(Str)
' MsgBox (Str)
Set pruneRange = Out_R
End Function
This works for a regular SUM loop, but for some reason it returns #Value when I try using it in a SUMIF or SUMIFS. Another issue is that even in the SUM loop if use C:C instead of C1:CX where X is however many rows, it crashes excel or takes forever to loop through. I'm guessing it's because excel doesn't know when to stop in a UDF unless I somehow tell it to?
Try this formula
=SUMPRODUCT(SUMIFS(D:D,A:A,"*03/2013*",C:C,"*"&L3:L30&"*"))
By using a range (L3:L30) for the final criterion the SUMIFS formula will generate an "array" (of 28 values - one for each value in L3:L30) ...and SUMPRODUCT is used to sum that array and get the result you want
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