I am working on a workbook in which I need to count how many times the "St/" substring is present in a Range (Column Q). Note: I am interested in all the occurrences, not just the number of cells in which the substring is present.
Here is the code I am trying to work with (based on the comment of Santhosh Divakar - https://stackoverflow.com/a/23357807/12536295), but I receive a runtime error (13) when running it. What am I missing / doing wrong?
Dim lastrow, q as Integer
lastrow = Range("A1").End(xlToRight).End(xlDown).Row
With Application
q = .SumProduct((Len(Range("Q1:Q" & lastrow)) - Len(.Substitute(Range("Q1:Q" & lastrow), "St/", ""))) / Len("St/"))
End With
See if the code below helps you:
Public Sub TestCount()
lastrow = Range("Q" & Rows.Count).End(xlUp).Row
strformula = "=SUMPRODUCT(LEN(Q1:Q" & lastrow & ")-LEN(SUBSTITUTE(UPPER(Q1:Q" & lastrow & "),""/ST"","""")))/LEN(""/St"")"
MsgBox Evaluate(strformula)
End Sub
I think you can count the number of characters, replace your "St/" with nothing and then count the characters again and divide by len("St/"). Here's an example.
'''your existing code
Dim lCount As Long
Dim lCount_After As Long
'''set a Range to column Q
Set oRng = Range("Q1:Q" & lRow_last)
'''turn that range into a string
sValues = CStr(Join(Application.Transpose(oRng.Value2)))
lCount = Len(sValues)
lCount_After = lCount - Len(Replace(sValues, "St/", ""))
lCount_After = lCount_After / 3
Debug.Print lCount_After
Using ArrayToText() function
a) If you dispose of Excel version MS365 you can shorten a prior string building by evaluating the tabular ARRAYTOTEXT()
formula to get a joined string of all rows at once (complementing #Foxfire 's valid solution).
Note that it's necessary to insert the range address as string;
in order to fully qualify the range reference I use an additional External:=True argument.
b) VBA's Split() function eventually allows to return the number of found delimiters (e.g. "St/") via
UBound() function. It returns the upper boundary (i.e. the largest available subscript) for this
zero-based 1-dimensional split array.
Example: If there exist eight St/ delimiters, the split array consists
of nine elements; as it is zero-based the first element has index 0
and the last element gets identified by 8 which is already the wanted function result.
Function CountOccurrencies(rng As Range, Optional delim as String = "St/")
'a) get a final string (avoiding to join cells per row)
Dim txt As String
txt = Evaluate("ArrayToText(" & rng.Address(False, False, External:=True) & ")")
'b) get number of delimiters
CountOccurrencies = UBound(Split(txt, delim))
End Function
Not the cleanest one, but you can take all into arrays and split by St/. Size of that array would be how many coincidences you got:
Sub test()
Dim LR As Long
Dim MyText() As String
Dim i As Long
Dim q As Long
LR = Range("Q" & Rows.Count).End(xlUp).Row
ReDim Preserve MyText(1 To LR) As String
For i = 1 To LR Step 1
MyText(i) = Range("Q" & i).Value
Next i
q = UBound(Split(Join(MyText, ""), "St/"))
Debug.Print q
Erase MyText
End Sub
The output i get is 8
Please, note this code is case sensitive.
The TextJoin() function in Excel 2019+ is used:
Sub CalcSt()
Const WHAT = "St/": Dim joined As String
joined = WorksheetFunction.TextJoin("|", True, Columns("Q"))
Debug.Print (Len(joined) - Len(Replace(joined, WHAT, ""))) / Len(WHAT)
End Sub
Related
I have 20 cases. For every row in my sheet, I have a cell that assigns related case numbers to it. A row could have multiple case numbers assigned to it in that cell (Example: 1,2,11,12)
I am writing a code to copy all the rows that have Case number 1 assigned to them, copy them someplace else..
and then go to case number 2 and repeat the same..
This is what I am using:
For CaseNumbers = 1 To 20
For i = Row1 To RowLast
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
COPY AND PASTE CODE
End If
Next
Next
The problem I am facing is, the code considers case number 11 as case number 1 too (since it has the digit 1).
This is the first time I am writing a VBA code and I have no background in this.
Can someone please advise on better way of doing this? Should I assign a checklist instead to each row?
All I want to do is find all the rows that have Case number 1 assigned, copy them.. then find all the rows that have Case 2 assigned, copy them.. and so on.
Please help.
You can use a function to do the test
Public Function isCaseNumberIncluded(ByVal caseToCheck As Long, ByVal caseNumbers As String) As Boolean
'add , to make all values distinct
caseNumbers = "," & caseNumbers & ","
Dim strCaseToCheck As String
strCaseToCheck = "," & caseToCheck & ","
If InStr(1, caseNumbers, strCaseToCheck) > 0 Then
isCaseNumberIncluded = True
End If
End Function
You would call this function within your main code like this:
Dim caseNumber As Long 'I removed the s - as this could be misleading in my eyes
For caseNumber = 1 To 20
For i = Row1 To RowLast
If isCaseNumberIncluded(caseNumber, Range(CaseNoCell & i).Value) Then
COPY AND PASTE CODE
End If
Next
Next
Using a separate function to run the test has two advantages:
your code gets more readable, ie you know from reading the functions name what the result should be - without reading the whole code how to do it :-)
you can re-use this code propably at another place
Or you can test the function first:
Public Sub test_isCaseNumberIncluded()
Debug.Print isCaseNumberIncluded(1, "1,2,11,12"), "Should be true"
Debug.Print isCaseNumberIncluded(1, "2,11,12"), "Should be false"
Debug.Print isCaseNumberIncluded(11, "1,2,11,12"), "Should be true"
Debug.Print isCaseNumberIncluded(11, "1,2,12"), "Should be false"
End Sub
Well, you are working with this piece of code:
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
This checks against 1,, 12,, ..., but obviously it won't cover the last entry so that's something you'll need to add. And you have the problem that 11, gets treated as 1,.
In a similar way you can use this piece of code:
If InStr(1, Range(CaseNoCell & i).Value, "," & CaseNumbers & ",") Then
This checks against ,1,, ,12,, ... so it will solve your error, but obviously it won't cover the last and the first entry so that's something you'll need to add.
This is something that should be encapsulated in a function rather than being done in line. The method provided in VBA for tokenising a string is 'Split'.
You could wite a function that checks tokens 1 by 1, or which compile a collection of the tokens which then uses a built checking method of the collection to determine if the specified token is present or not.
In this specific case I've chosen to use the collection method. The specific object for the collection is the ArrayList (but a Scripting.Dictionary is also possible). The function contains checks for zero length strings and allows the seperator to be specified if it isn't a comma.
Option Explicit
Function FindToken(ByVal ipToken As String, ByVal ipTokenList As String, Optional ByVal ipSeparator As String = ",") As Boolean
' Guard against ipSeparator being vbnullstring
Dim mySeparator As String
mySeparator = IIf(VBA.Len(ipSeparator) = 0, ",", ipSeparator)
'Raise an error if ipToken or ipTokenList are empty strings
If VBA.Len(ipToken) = 0 Or VBA.Len(ipTokenList) = 0 Then
Err.Raise 17, "Empty string error"
End If
'Convert the token list to tokens
Dim myTokens As Variant
myTokens = VBA.Split(ipTokenList, mySeparator)
' Put the tokens in an ArrayList so we can use the contains method
' no point is doing early binding as arraylist doesn't provide intellisense
Dim myAL As Object
Set myAL = CreateObject("System.Collections.ArrayList")
Dim myItem As Variant
For Each myItem In myTokens
' Trim just in case there are spaces
myAL.Add VBA.Trim(myItem)
Next
'Finally test if the Token exists in the token list
Find = myAL.contains(VBA.Trim(ipToken))
End Function
This means that your code
If InStr(1, Range(CaseNoCell & i).Value, CaseNumbers & ",") Then
can now be rewritten as
If FindToken(CStr(CaseNUmbers), Range(CaseNoCell & cstr(i)).Value) Then
Identify Criteria Rows
Option Explicit
Sub Test()
Const WordSeparator As String = ","
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim CaseNumber As Long
Dim i As Long
Dim cValue As Variant
Dim cString() As String
For CaseNumber = 1 To 20
For i = Row1 To RowLast
cValue = CStr(ws.Range(CaseNoCell & i).Value)
If Len(cValue) > 0 Then
cString = Split(cValue, WordSeparator)
If IsNumeric(Application.Match( _
CStr(CaseNumber), cString, 0)) Then
' CopyAndPasteCode CaseNumber
Debug.Print "Case " & CaseNumber & ": " & "Row " & i
End If
End If
Next i
Next CaseNumber
End Sub
I am having a problem with a particular line of code:
ActiveSheet.Range("A" & rowCount & ":" & Mid(alphabet, totHdrLngth, 1) & belowRowCount)
Where alphabet is a string containing uppercase letters A to Z.
I keep getting the following error:
Run-time error '5':
Invalid Procedure call or argument
I tried creating a String "inRange" and changing the code to this:
inRange = "A" & rowCount & ":" & Mid(alphabet, totHdrLngth, 1) & belowRowCount
curRange = ActiveSheet.Range(inRange)
But that did not help (as I thought it wouldn't). Any suggestions?
Although creating ranges like this is frowned upon in general, the way to do it is with the word SET (like #Gary McGill stated in the comments). Here is an example of how to do this:
Sub test()
Dim alphabet As String
Dim totHrdrLngth As Long
Dim belowRowCount As Long
Dim rowCount As Long
Dim inRange As Range
alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
totHrdrLngth = 5
belowRowCount = 10
rowCount = 5
' Gives us A5:E10
Set inRange = Range("A" & rowCount & ":" & range2 & _
Mid$(alphabet, totHrdrLngth, 1) & belowRowCount)
End Sub
You are running this macro in the current range, so there should be no need to specify ActiveSheet.Range. I hope this helps get you toward what you are trying to achieve.
As far as I can tell, you're getting an error because your types don't match up. I imagine rowCount is an integer, as is belowRowCount. If you convert them to strings before concatenating them, you can fix it. str() will convert an integer to a string with a space before it, and LTrim() will remove the space. Try code as below:
Dim sRowCount As String
Dim sBelowRowCount As String
and later
sRowCount = LTrim(Str(RowCount))
sBelowRowCount = LTrim(Str(belowRowCount))
inRange = "A" & sRowCount & ":" & Mid(alphabet, totHdrLngth, 1) & sBelowRowCount
curRange = ActiveSheet.Range(inRange)
Hope this helps.
I want to use VBA to split the contents of a cell into three separate parts, such as [city], [state] [zip code] are put into three different columns on the same row while leaving the original cell unchanged.
I had thought that split would work, but unfortunately I have encountered some complicating issues, first split seems to only carry over the what's on the left, leaving behind the rest, second, I don't see how I can incorporate two delimiters into a single split.
Any idea how to surmount these issues?
Cells(Row1, ColA).Select
Location = ActiveCell.Value
Cells(Row1, ColC) = Split(Location, ",")
Cells(Row1, ColA).Select
Cells(Row1, ColD) = Split(Location, " ")
Cells(Row1, ColA).Select
Cells(Row1, ColE) = Split(Location, " ")
Split() returns an array of strings, you need to iterate through this array and assign the value of each element to the corresponding cell (take a look at this answer).
Also, you don't need to select cells to assign values to it, you may use:
Cells(Row,Column).Value = X
Regarding 2 delimiters, you may do it as described here.
Use the Split, I use an array in the middle just to store the split String (in case you will want to use it later), it also saves me the time of the iteration.
Sub Split_toThree()
Dim lrow As Long
Dim LastRow As Long
Dim SplitArr() As String
' find last row in Column A (where you keep your full string)
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For lrow = 2 To LastRow
SplitArr() = Split(Cells(lrow, "a"), ",")
Range("C" & lrow & ":E" & lrow) = SplitArr()
Next lrow
End Sub
Could someone help me create a function that will handle an unlimited number of diverse ranges? I have tried "Paramarray variables() as Variant" and "variable as Range" in my arguments list but neither of them provide the versatility that I am looking for.
The key is that I want my function to be able to simultaneously handle things like "MyFunc(A1:A10, B1)" or "MyFunc(A1, B1:10, C11)". The problem I'm finding is that "ParamArray" can only handle comma separated inputs while "variable as Range" can only handle non-comma separated inputs.
Basically, I want to have the same functionality that the SUM() function has. Where SUM can handle an infinite (sort of) number of inputs regardless if they are separated by commas or are in a range.
As requested, here is my code:
Function COMMA_DELIMITER(inputs as Range)
' this function basically concatenates a consecutive set of cells and places commas between values
For Each j in Inputs
stringy = stringy & j.value & chr(44)
Next
stringy = Left(stringy, Len(stringy) - 1)
COMMA_DELIMITER = stringy
End Function
or
Function COMMA_DELIMITER_A(ParamArray others())
'this is the same function, only the cells don't have to be consecutive
For i = 1 to UBound(others) + 1
stringy = stringy & others(i-1) & chr(44)
Next
COMMA_DELIMIERTER_A = Left(stringy, Len(stringy) - 1)
End Function
I pretty much want to create a function that has the flexibility to handle both consecutive cells and/or non-consecutive cells. The inputs would look like this, "=MyFunc(A1, B1:B10, C11, D12:D44)".
Could someone help me create a function that can handle something like this, "MyFunc(A1, B1:B10, C11, D12:D44)"?
Thanks,
Elias
Actually it is possible to do that, and code from chris neilsen is almost there.
Function MyFunc1(ParamArray r()) As Variant
Dim rng As Range
Dim i As Long
Dim j As Variant
Dim s As String
For i = LBound(r) To UBound(r)
For each j in r(i)
s = s & " " & j.Address
Next
Next
MyFunc1 = s
End Function
See? You only have to put one more loop, so if you have a range like [A1:A4] it will loop for into that too. One loop will return another ParamArray, so you have to loop for twice. And if you have just [A1] that's not a problem either, the double looping will cause no problem.
I think there are two issues with your approach
, and (comma and space) are the Union and Intersect operators for ranges
To pass a multi area range into a single parameter, you need to enclose it in ( )
To demonstrate
ParamArray version
Loop through the array variable to access to individual ranges
Function MyFunc1(ParamArray r()) As Variant
Dim rng As Range
Dim i As Long
Dim s As String
For i = LBound(r) To UBound(r)
s = s & " " & r(i).Address
Next
MyFunc1 = s
End Function
Range version
Iterate the range Areas collection to access individual ranges
Function MyFunc2(r As Range) As Variant
Dim rng As Range
Dim i As Long
Dim s As String
For Each rng In r.Areas
s = s & " " & rng.Address
Next
MyFunc2 = s
End Function
Both
=MyFunc1(B5:D5 C4:C6,B10:E10,D13:D16)
and
=MyFunc2((B5:D5 C4:C6,B10:E10,D13:D16))
will return
$C$5 $B$10:$E$10 $D$13:$D$16
(note that the intersection of B5:D5 and C4:C6 is C5)
I am trying to use a vlookup or similar function to search a worksheet, match account numbers, then return a specified value. My problem is there are duplicate account numbers and I would like the result to concatenate the results into one string.
Acct No CropType
------- ---------
0001 Grain
0001 OilSeed
0001 Hay
0002 Grain
Is in the first worksheet, on the 2nd worksheet I have the Acct No with other information and I need to get all the matching results into one column on the 2nd worksheet ie. "Grain Oilseed Hay"
Here is a function that will do it for you. It's a little different from Vlookup in that you will only give it the search column, not the whole range, then as the third parameter you will tell it how many columns to go left (negative numbers) or right (positive) in order to get your return value.
I also added the option to use a seperator, in your case you will use " ". Here is the function call for you, assuming the first row with Acct No. is A and the results is row B:
=vlookupall("0001", A:A, 1, " ")
Here is the function:
Function VLookupAll(ByVal lookup_value As String, _
ByVal lookup_column As range, _
ByVal return_value_column As Long, _
Optional seperator As String = ", ") As String
Dim i As Long
Dim result As String
For i = 1 To lookup_column.Rows.count
If Len(lookup_column(i, 1).text) <> 0 Then
If lookup_column(i, 1).text = lookup_value Then
result = result & (lookup_column(i).offset(0, return_value_column).text & seperator)
End If
End If
Next
If Len(result) <> 0 Then
result = Left(result, Len(result) - Len(seperator))
End If
VLookupAll = result
End Function
Notes:
I made ", " the default seperator for results if you don't enter one.
If there is one or more hits, I added some checking at the end to
make sure the string doesn't end with an extra seperator.
I've used A:A as the range since I don't know your range, but
obviously it's faster if you enter the actual range.
One way to do this would be to use an array formula to populate all of the matches into a hidden column and then concatenate those values into your string for display:
=IFERROR(INDEX(cropTypeValues,SMALL(IF(accLookup=accNumValues,ROW(accNumValues)-MIN(ROW(accNumValues))+1,""),ROW(A1))),"")
cropTypeValues: Named range holding the list of your crop types.
accLookup: Named range holding the account number to lookup.
accNumValues: Named range holding the list of your account
numbers.
Enter as an array formula (Ctrl+Shift+Enter) and then copy down as far as necessary.
Let me know if you need any part of the formula explaining.
I've just had a similar problem and I have looked up similar solutions for a long time, nothing really convinced me though. Either you had to write a macro, or some special function, while yet, for my needs the easiest solution is to use a pivot table in e.g. Excel.
If you create a new pivot table from your data and first add "Acct No" as row label and then add "CropType" as RowLabel you will have a very nice grouping that lists for each account all the crop types. It won't do that in a single cell though.
Here is my code which even better than an excel vlookup because you can choose to criterie colum, and for sure a separator (Carriege return too)...
Function Lookup_concat(source As String, tableau As Range, separator As String, colSRC As Integer, colDST As Integer) As String
Dim i, y As Integer
Dim result As String
If separator = "CRLF" Then
separator = Chr(10)
End If
y = tableau.Rows.Count
result = ""
For i = 1 To y
If (tableau.Cells(i, colSRC) = source) Then
If result = "" Then
result = tableau.Cells(i, colDST)
Else
result = result & separator & tableau.Cells(i, colDST)
End If
End If
Next
Lookup_concat = result
End Function
And a gift, you can make also a lookup on multiple element of the same cell (based on the same separator). Really usefull
Function Concat_Lookup(source As String, tableau As Range, separator As String, colSRC As Integer, colDST As Integer) As String
Dim i, y As Integer
Dim result As String
Dim Splitted As Variant
If separator = "CRLF" Then
separator = Chr(10)
End If
Splitted = split(source, separator)
y = tableau.Rows.Count
result = ""
For i = 1 To y
For Each word In Splitted
If (tableau.Cells(i, colSRC) = word) Then
If result = "" Then
result = tableau.Cells(i, colDST)
Else
Dim Splitted1 As Variant
Splitted1 = split(result, separator)
If IsInArray(tableau.Cells(i, colDST), Splitted1) = False Then
result = result & separator & tableau.Cells(i, colDST)
End If
End If
End If
Next
Next
Concat_Lookup = result
End Function
Previous sub needs this function
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Function VLookupAll(vValue, rngAll As Range, iCol As Integer, Optional sSep As String = ", ")
Dim rCell As Range
Dim rng As Range
On Error GoTo ErrHandler
Set rng = Intersect(rngAll, rngAll.Columns(1))
For Each rCell In rng
If rCell.Value = vValue Then
VLookupAll = VLookupAll & sSep & rCell.Offset(0, iCol - 1).Value
End If
Next rCell
If VLookupAll = "" Then
VLookupAll = CVErr(xlErrNA)
Else
VLookupAll = Right(VLookupAll, Len(VLookupAll) - Len(sSep))
End If
ErrHandler:
If Err.Number <> 0 Then VLookupAll = CVErr(xlErrValue)
End Function
Use like this:
=VLookupAll(K1, A1:C25, 3)
to look up all occurrences of the value of K1 in the range A1:A25 and to return the corresponding values from column C, separated by commas.
If you want to sum values, you can use SUMIF, for example
=SUMIF(A1:A25, K1, C1:C25)
to sum the values in C1:C25 where the corresponding values in column A equal the value of K1.
ALL D BEST.