I am trying to use wildcards in a formula to count cells in a table column which contain text and not ""
I tried the following methods:
String comparison
Dim g As Integer
g = Application.WorksheetFunction.CountIf(ThisWorkbook.Worksheets("ws1").ListObjects("Table1").ListColumns("ColumnA").DataBodyRange, ""*?"")
Using a tilde failed:
Dim g As Integer
g = Application.WorksheetFunction.CountIf(ThisWorkbook.Worksheets("ws1").ListObjects("Table1").ListColumns("ColumnA").DataBodyRange, ""~*?"")
Using ASCII characters below returned 0:
g = Application.WorksheetFunction.CountIf(ThisWorkbook.Worksheets("ws1").ListObjects("Table1").ListColumns("Column1").DataBodyRange, Chr(34) & Chr(63) & Chr(42) & Chr(34))
Tried and tested:
Public Function not_qt(ByVal rng As Range) As Integer
Dim cell As Range
Dim counter As Integer: counter = 0
For Each cell In rng
If Not IsEmpty(cell) Then
If Not cell Like Chr(34) & "*" & Chr(34) Then
counter = counter + 1
'cell.Offset(0, 1) = counter '<- Only for illustration purposes
End If
End If
Next cell
not_qt = counter
End Function
Related
For a project, I'm creating an Excel macro to count unique column values based on another column value. Here is a basic example of the macro I'm trying to create:
Data
col_1
col_2
a
x
a
y
b
z
b
z
Macro
Sub Main()
Dim Param As String
Param = "a"
MsgBox UniqueValues(Param)
End Sub
Function UniqueValues(Param As String) As String
Dim EvaluateString As String
EvaluateString = "=SUM(--(LEN(UNIQUE(FILTER(B:B,A:A=" & """" & Param & """" & ","""")))>0))"
UniqueValues = Evaluate(EvaluateString)
End Function
Expectation
The expectation is that for Param = "a" the function returns 2 and for Param = "b" it returns 1.
Issue
Even though function works perfpectly in Excel for Microsoft 365 Apps for Enterprise, the project requires me to use Excel for Microsoft Office Standard 2013. This version doesn't support the use of the UNIQUE and FILTER functions used in EvaluateString.
I want to understand if there's a simple way to count the unique values in a column based on a value in another column in Excel for Microsoft Office Standard 2013. Your help is much appreciated.
You can use the array formula
=SUM(IF($A$1:$A$5="a",1/COUNTIFS($A$1:$A$5,"a",$B$1:$B$5,$B$1:$B$5)),0)
After entering the formula, instead of Enter, you need to press Ctl + Shift + Enter
In VBA, the above formula can be used as shown below
Option Explicit
Sub Main()
Dim Param As String
Param = "b"
MsgBox "The count for " & Param & " is " & UniqueValues(Param)
End Sub
Function UniqueValues(Param As String) As String
Dim EvaluateString As String
Dim ws As Worksheet
'~~> Change this to the relevant worksheet
Set ws = Sheet1
'SUM(IF(Sheet1!A1:A5="a",1/COUNTIFS(Sheet1!A1:A5,"a",Sheet1!B1:B5,Sheet1!B1:B5)),0)
EvaluateString = "SUM(IF($A$1:$A$5=" & _
Chr(34) & Param & Chr(34) & _
",1/COUNTIFS($A$1:$A$5," & _
Chr(34) & Param & Chr(34) & _
",$B$1:$B$5," & _
"$B$1:$B$5)),0)"
UniqueValues = ws.Evaluate(EvaluateString)
End Function
In Action
When your data are in "Sheet1", columns A and B, starting in row 1, you can use this macro (results in columns D and E):
Sub macro1()
Dim a As Integer, p As Integer, x As Integer, y As Integer
a = 0: p = 0: x = 1: y = 1
With Sheets("Sheet1")
.Columns("d:e").ClearContents
Do Until x > .Cells(.Rows.Count, 1).End(xlUp).Row
a = 1
Do While .Cells(x, 1) = .Cells(y, 1)
If .Cells(x, 2) <> .Cells(y, 2) Then a = a + 1
x = x + 1
Loop
p = p + 1
.Cells(p, 4) = .Cells(y, 1)
.Cells(p, 5) = a
y = x
Loop
End With
End Sub
I am new to VBA and learning myself...
I am facing a similar problem with this post: Excel Vba - Group number sequence inside a string
which the difference is that my item no. is in horizontal like below:
ColA(ID) ColB ColC ColD ColE ColF ColG
A 101 102 103
B 201 202 203 501 502
Sometimes for an ID, there will only have 3 item no., sometimes with 5, they can be upto 30 sometimes...
What I think the function could look like this: Cell G1 = lookupsequence(A1:A30), since that lookup function is no need in this situtation
Then G1 -> 101-103
Then G2 -> 201-203, 501-502
Below is the code I have based on that post, but just generating G1: 101, 102, 103
Lookupsequence(Return_val_col As Range)
Dim i As Long
Dim result As String
Dim initial As String
Dim separator As String
Dim preValue As Integer
Dim value As Integer
preValue = -1
separator = ""
For i = 1 To 30
value = CInt(Return_val_col.Cells(1, i).value)
If value - 1 = preValue Then
result = initial & "-" & value
Else
result = result & separator & value
initial = result
separator = ","
End If
Next
Lookupsequence = Trim(result)
End Function
I tried to add something like but not succeed
Dim lastcol As Long
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To lastcol
Thank you
Assuming a max of 30 numbers within the limits of rownumbers of Excel, try:
Function GetSequence(rng1 As Range) As String
Dim rng2 As Range
For Each cl In rng1.SpecialCells(2, 1)
If rng2 Is Nothing Then
Set rng2 = Cells(cl.Value, 1)
Else
Set rng2 = Union(rng2, Cells(cl.Value, 1))
End If
Next
GetSequence = Replace(Replace(rng2.Address(False, False), "A", ""), ":", "-")
End Function
Invoke through: =GetSequence(B1:D1) or whichever range holding the numbers.
If numbers get too large and too many for the above function, try:
Function GetSequence(rng As Range) As String
Dim arr As Variant: arr = rng.Value
With CreateObject("System.Collections.ArrayList")
For Each el In arr
If IsNumeric(el) And el <> "" Then .Add el
Next
.Sort
For i = .Count - 1 To 0 Step -1
If i = .Count - 1 Then
GetSequence = .Item(i) & "|"
Else
If Val(GetSequence) = .Item(i) + 1 Then
If Mid(GetSequence, Len(.Item(i)) + 1, 1) = "-" Then
GetSequence = .Item(i) & Mid(GetSequence, Len(CStr(Val(GetSequence))) + 1)
Else
GetSequence = .Item(i) & "-" & GetSequence
End If
Else
GetSequence = .Item(i) & "," & GetSequence
End If
End If
Next
End With
GetSequence = Replace(GetSequence, "|", "")
End Function
It's abit verbose but this way can even insert empty or unsorted arrays of numbers:
I tested this code and it worked correctly for me. I returned to the page and saw the solution from JvdV; so I thought I'd post my solution too.
Option Explicit
Private Sub Test()
Dim result$
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("Sheet3")
result$ = Lookupsequence(WS.Range("B1:AE1"))
result$ = Lookupsequence(WS.Range("B2:AE2"))
result$ = Lookupsequence(WS.Range("B3:AE3"))
End Sub
Private Function Lookupsequence(Return_val_col As Range) As String
Dim preValue%, value%
Dim i&
Dim result$, separator$
preValue = -1
result = ""
separator = ", "
For i = 1 To Return_val_col.count
value = CInt(Return_val_col.Cells(1, i).value)
If value = 0 Then
Exit For
ElseIf result = "" Then
result = value
ElseIf value - 1 <> preValue Then
result = result & "-" & preValue & separator & value
End If
preValue = value
Next
If value = 0 Then
value = preValue
End If
result = result & "-" & value
Lookupsequence = Trim(result)
End Function
My test data in two images from columns A to AE to test the possibility of 30 item numbers
I have a line of code that returns 1d array based on a value in range A1. Example suppose there's a value 6548102 in A1 and I used this line x = [TRANSPOSE(MID(A1,1+len(A1)-ROW(OFFSET(A1,,,LEN(A1))),1))] this line returned a 1d array of each digit in A1
This is my try
Sub Demo()
Dim x
Dim s As String
s = "6548102"
'x = [TRANSPOSE(MID(A1,1+len(A1)-ROW(OFFSET(A1,,,LEN(A1))),1))]
x = [TRANSPOSE(MID(" & s & ",1+LEN(" & s & ")-ROW(OFFSET(" & s & ",,,LEN(" & s & "))),1))]
Stop
End Sub
I tried to replace A1 with the string variable but it seems this trick doesn't work.
Simply I need to deal with a string not a range with the same technique.
It would be simple to just use VBA:
Sub ReverseDemo()
dim s as string
s = "6548102"
dim x() as variant
redim x(0 to len(s) - 1) as variant
dim k as long
k = 0
dim i as long
for i = len(s) to 1 step -1
x(k) = mid(s,i,1)
k = k + 1
Next i
'Do something with x
End Sub
Split with Evaluate
Instead of using [] use Evaluate, and don't replace A1 in the OFFSET part of the formula with the value you want to split.
Sub Demo()
Dim x
Dim s As String
s = 123
x = Evaluate("TRANSPOSE(MID(""" & s & """,ROW(OFFSET(A1,,,LEN(""" & s & """))),1))")
Debug.Print Join(x, "-")
End Sub
Strings
If you actually want to split a string you would need to add double quotes throughout.
Sub StringDemo()
Dim x
Dim s As String
s = "Yassser"
x = Evaluate("TRANSPOSE(MID(""" & s & """,ROW(OFFSET(A1,,,LEN(""" & s & """))),1))")
Debug.Print Join(x, "-")
End Sub
Actually, you probably want to use the second code as it will work for both strings and numbers.
Reverse
If, for some reason you wanted the characters/digits in reverse order you can use this.
Sub ReverseDemo()
Dim x
Dim s As String
s = "Reverse"
x = Evaluate("TRANSPOSE(MID(""" & s & """,1+LEN(""" & s & """)-ROW(OFFSET(A1,,,LEN(""" & s & """))),1))")
Debug.Print Join(x, "-")
End Sub
New to VBA, trying to create a function that essentially searches a column for certain values. If it finds a hit then it returns a corresponding column, else returns a space. The way the worksheet is formatted, one cell can have multiple values (separated by ALT+ENTER, so each new value is on a separate line).
The code I used currently works but has an issue:
Since I am using inStr the code is returning partial matches as well (which I do not want).
Example:
**Column to Search (one cell)**
ABC
AB
B
When I run the code to find AB, it will return hits for both AB and ABC since AB is part of it.
Ideal solution would be to first split the cells based on ALT+ENTER and loop through all values per cell and then return the desired value. But not how the syntax would look.
Current Code
Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range)
Dim i As Long
Dim result As String
Dim mRange As Range
Dim mValue As String
For i = 1 To Search_in_col.Count
If InStr(1, Search_in_col.Cells(i, 1).Text, Search_string) <> 0 Then
If (Return_val_col.Cells(i, 1).MergeCells) Then
Set mRange = Return_val_col.Cells(i, 1).MergeArea
mValue = mRange.Cells(1).Value
result = result & mValue & ", "
Else
result = result & Return_val_col.Cells(i, 1).Value & ", "
End If
End If
Next
Example:
Adding an example to better explain the situation
you can split the string and loop that.
Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range) As String
If Search_in_col.Cells.Count <> Return_val_col.Cells.Count Then Exit Function
Dim sptStr() As String
sptStr = Split(Search_string, Chr(10))
Dim srchArr() As Variant
srchArr = Search_in_col.Value
Dim RetArr() As Variant
RetArr = Return_val_col.Value
Dim i As Long
For i = LBound(sptStr) To UBound(sptStr)
Dim j As Long
For j = LBound(srchArr, 1) To UBound(srchArr, 1)
If srchArr(j, 1) = sptStr(i) Then
newFunc = newFunc & RetArr(j, 1) & ", "
End If
Next j
Next i
newFunc = Left(newFunc, Len(newFunc) - 2)
End Function
EDIT:
As per the new information:
Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range) As String
Search_string = "|" & Search_string & "|"
Dim srchArr() As Variant
srchArr = Search_in_col.Value
Dim RetArr() As Variant
RetArr = Return_val_col.Value
Dim i As Long
For i = LBound(srchArr, 1) To UBound(srchArr, 1)
Dim T As String
T = "|" & Replace(srchArr(i, 1), Chr(10), "|") & "|"
If InStr(T, Search_string) > 0 Then
newFunc = newFunc & RetArr(i, 1) & ", "
End If
Next i
newFunc = Left(newFunc, Len(newFunc) - 2)
End Function
You can use regular expressions which have a word boundary token.
The following seems to reproduce what you show in your example:
Option Explicit
'Set reference to Microsoft VBScript Regular Expressions 5.5
Function col_return(lookFor As String, lookIn As Range) As String
Dim RE As RegExp
Dim C As Range
Dim S As String
Set RE = New RegExp
With RE
.Global = True
.IgnoreCase = True 'unless you want case sensitive searches
For Each C In lookIn
.Pattern = "\b(" & lookFor & ")\b"
If .Test(C.Text) = True Then
S = S & "," & C.Offset(0, -1)
End If
Next C
End With
col_return = Mid(S, 2)
End Function
I used early binding, which means you set a reference in VBA as noted in the comments.
You can use late-binding and avoid the reference. To do that you would change to the DIM and Set lines for RE to:
DIM RE as Object
Set RE = createobject("vbscript.regexp")
You can read about early vs late-binding by doing an internet search.
The formula I used and the layout is in the screenshot below:
I am trying to build a user defined function using VBA for excel. That would concatenate a list of stores which has a x mark in that row.
Store1 Store2 Store3 Concatenate
x x Store1,Store3
x x tore1,Store2
x Store1
I managed to write this vba code, but I am not sure this is the best approach. As I was tesing in on 1000 and more lines, it was quite slow. Maybe it is possible to optimise it?
firstStore you point where the first store starts (not the names, but the x marks,lastStore1 the last column. listofstores1 is the row where the store names are.
Function listofstores(firstStore As Range, lastStore1 As Range, listofstores1 As Range)
Application.Volatile
Dim offsetvalue As Integer
offsetvalue = -(lastStore1.Row - listofstores1.Row)
lastStore = lastStore1.Column
Set initial = firstStore
For i = 1 To lastStore
If initial = "X" Or initial = "x" Then Store = initial.Offset(offsetvalue, 0)
c = 1
Set initial = initial.Offset(0, c)
listofstores = listofstores & " " & Store
Store = ""
Next i
End Function
Short but intricate.
uses Evaluate to return an array of matches (Store numbers v x)
Filter removes the non-matches ("V")
Join to make the string from the final array of matches
UDF
Function Getx(Rng1 As Range, Rng2 As Range) As String
Getx = Join(Filter(Evaluate("=ÏF(" & Rng2.Address & "=""x""," & Rng1.Address & ",""V"")"), "V", False), ",")
End Function
Another way to achieve is as below. You can do any where in sheets
Sub Main()
Call getlistofstores(Range("G13:L15"), Range("G12:L12"))
End Sub
Function getlistofstores(stores As Range, listofstores As Range)
Application.Volatile
Dim fullconcatstring As String
Dim row As Integer
Dim column As Integer
a = stores.Count / listofstores.Count
b = listofstores.Count
row = stores.Cells(1).row
column = stores.Cells(1).column + (b)
For i = 1 To a
For j = 1 To b
If stores.Cells(i, j) = "x" Then
If concatstring <> "" Then
concatstring = concatstring & ", " & listofstores.Cells(j)
Else
concatstring = listofstores.Cells(j)
End If
End If
Next j
fullconcatstring = fullconcatstring & Chr(10) & Chr(11) & concatstring
concatstring = ""
Next i
Call concatenateallstores(row, column, fullconcatstring)
End Function
Sub concatenateallstores(r As Integer, c As Integer, d As String)
str1 = Split(d, Chr(10) & Chr(11))
str2 = UBound(str1)
For i = 1 To str2
Cells(r, c) = str1(i)
r = r + 1
Next i
End Sub