We have the column "following ID", which contains IDs of predecessors in the format "1; 2; 3; 4". Now I want to find the ID inside a specific cell. My problem is, that if I f.e. searching for "1", it also is true when there is a "11, 21, 13, 14, ..." inside the cell. Is there a way to search for the "ID" in "following ID", without getting true when the ID is part of an other ID?
For i = 2 To 250
Dim tmp As String
tmp = ""
If Cells(i, 1) = "" Then Exit For
For j = 2 To 250
If Cells(j, 1) = "" Then
Exit For
End If
If Cells(j, 11) = Cells(i, 1) Then
If tmp = "" Then
tmp = Cells(j, 1)
Else
tmp = tmp & "; " & Cells(j, 1)
End If
End If
Next j
Cells(i, 10) = tmp
Next i
Picture of Data
What you try to do can be described minimally with the following:
- Try to search for "1" in the string "1;2;3;4;11;12;13", returning only "1" and not "11", "12", "13".
This is a way to do it:
split the string to array by ";"
search in the array
The code would look like this:
Option Explicit
Public Sub TestMe()
Dim inputA As String
Dim cnt As Long
Dim arr As Variant
inputA = "1;2;3;4;11;12;13"
arr = Split(inputA, ";")
For cnt = LBound(arr) To UBound(arr)
If 1 = arr(cnt) Then
Debug.Print "Found in position " & cnt
Exit For
End If
Next cnt
End Sub
You can create a UDF like below:
Public Function FindID(rngToCheck As Range, strVal As String) As Boolean
If InStr(1, ";" & Replace(rngToCheck.Value, " ", "") & ";", ";" & strVal & ";", vbTextCompare) > 0 Then FindID = True
End Function
And then check the cell like below assuming your data is in Cell A2:
=FindID(A2,"1")
Related
I write a VBA CODE that's filter a column and return the result in msgbox. The problem is: the msgbox does not show me all the values because the column contains more than 100 values.
My question is: how can I modify the form of the msgbox and separate it with comma.
Many thanks
Sub Fstr()
Dim str As String
Dim j As Integer
j = 2
For i = 1 To ActiveSheet.UsedRange.Count
If Cells(i, 6) = "CEM" Then
str = str & CStr(Cells(i, 2)) & vbCrLf
'ThisWorkbook.Sheets("BDD").Range("B" & j) = Cells(i, 4)
j = j + 1
End If
Next i
MsgBox str
End Sub
To add a user form and show the str:
Go to VBA Editor window
Insert a UserForm
Add a TextBox from Controls
Right click the textbox and click properties
from the properties change the Multiline = True
You can show the form using the below code
In Module1:
Sub Fstr()
Dim str As String
Dim j As Integer
j = 2
For i = 1 To ActiveSheet.UsedRange.Count
If Cells(i, 6) = "CEM" Then
str = str & CStr(Cells(i, 2)) & vbCrLf
'ThisWorkbook.Sheets("BDD").Range("B" & j) = Cells(i, 4)
j = j + 1
End If
Next i
'MsgBox str
UserForm1.TextBox1.Text = str
UserForm1.Show
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 want to separate text (names) from numbers (IDs), but there are some exceptions.
Code separates text from numbers but some of the IDs have a letter at the beginning.
How do I obtain full ID with a letter, if applicable?
Option Explicit
Sub NamesandID()
Dim RowNum As Long
Dim eChar As Integer
RowNum = 2
Do Until Cells(RowNum, 1).Value = ""
For eChar = 1 To Len(Cells(RowNum, 1))
If IsNumeric(Mid(Cells(RowNum, 1), eChar, 1)) = True Then
Cells(RowNum, 3).Value = Cells(RowNum, 3).Value _
& Mid(Cells(RowNum, 1), eChar, 1)
Else
Cells(RowNum, 2).Value = Cells(RowNum, 2).Value _
& Mid(Cells(RowNum, 1), eChar, 1)
End If
Next
RowNum = RowNum + 1
Loop
End Sub
My two cents.
1): Through formulae:
Formula in B2:
=LET(X,TEXTAFTER(TEXTBEFORE(A2:A5,")"),"("),HSTACK(SUBSTITUTE(A2:A5," ("&X&")","",1),X))
2) Through VBA:
Sub Test()
Dim arr As Variant: arr = Array("Ann Smith (A123456)", "Tom Ford(2453234)", "Alex Mohammet(4447434)(Text)", "Gerard Kowalski(A6739263)")
With CreateObject("vbscript.regexp")
.Pattern = "^(.+?)\s*\(([A-Z]?\d+)\)(.*)$"
For Each el In arr
tmp = .Replace(el, "$1$3|$2")
Debug.Print Split(tmp, "|")(0) 'Print name
Debug.Print Split(tmp, "|")(1) 'Print ID
Next
End With
End Sub
For those interested in a breakdown of the regular expression used, follow this link.
Another option with VBA is to use Split(), for example:
Sub Test()
Dim arr As Variant: arr = Array("Ann Smith (A123456)", "Tom Ford (2453234)", "Alex Mohammet (4447434)(Text)", "Gerard Kowalski (A6739263)")
Dim tmp As String
For Each el In arr
tmp = Split(Split(el, "(")(1), ")")(0)
Debug.Print Application.Trim(Replace(el, "(" & tmp & ")", "")) 'Print Name
Debug.Print tmp 'Print ID
Next
End Sub
Both options would print:
You can do this with a formula:
Name-column: =MID([#worker],1,FIND("(", [#worker])-1)
ID-column: =MID([#worker],FIND("(",[#worker])+1,FIND(")",[#worker])-FIND("(",[#worker])-1)
If you are on the Beta-Channel of excel 365 than you might already have TEXTSPLIT and TEXTBEFORE.
Sub NamesandID()
Dim RowNum As Long
RowNum = 2
Do Until Cells(RowNum, 1).Value = ""
'f you need parenthesis in the name concatenate them at the end, something like below
'Range("B" & RowNum).Value = Split(Range("A" & RowNum), " (")(0) & " ()"
Range("B" & RowNum).Value = Split(Range("A" & RowNum), " (")(0) 'no parenthesis at the end
Range("C" & RowNum).Value = Split(Split(Range("A" & RowNum), " (")(1), ")")(0)
RowNum = RowNum + 1
Loop
End Sub
I am looking for a formula to list occurrences of values only if they are greater than 2 times; and the result would be shown as in the image.
For example, if a value repeats 2 times, it's shown by "2", and 3 times by "3". so if there are two numbers repeating in the range, then it would be shown by "32" as in the image below. (There is no need for a comma between the numbers). Thanks.
Here is a simple UDF:
Function mycount(rng As Range) As String
Dim str As String
Dim rngcnt As Range
For Each rngcnt In rng
If InStr("," & str & ",", "," & rngcnt.Value & ",") = 0 Then
If Application.WorksheetFunction.CountIf(rng, rngcnt) > 1 Then
mycount = mycount & Application.WorksheetFunction.CountIf(rng, rngcnt)
str = str & "," & rngcnt
End If
End If
Next rngcnt
End Function
So your call on the sheet would be:
=mycount(A2:H2)
Then copy down.
The way I got it is defining a VBA function.This function uses a dictionary, so it is necessary to add th reference to 'Microsoft Scripting Runtime' (look here). Also, I have used a function to sort the characters in string from here
Function Repetitions(rng As Range)
Dim dict As New Scripting.Dictionary
Dim res() As Integer
For aux = 1 To rng.Count
Dim numero As Integer
numero = rng.Cells(1, aux).Value
If Not dict.Exists(numero) Then
dict.Add numero, 1
Else
dict(numero) = dict(numero) + 1
End If
Next aux
Dim result As String
result = ""
For aux = 0 To UBound(dict.Items)
If dict.Items(aux) > 1 Then result = result & dict.Items(aux)
Next aux
While Len(result)
iTemp = 1
Temp = Left(result, 1)
For I = 2 To Len(result)
If StrComp(Mid(result, I, 1), Temp, vbTextCompare) = 0 Then
If StrComp(Mid(result, I, 1), Temp, vbBinaryCompare) = 1 Then
Temp = Mid(result, I, 1)
iTemp = I
End If
End If
If StrComp(Mid(result, I, 1), Temp, vbTextCompare) = 1 Then
Temp = Mid(result, I, 1)
iTemp = I
End If
Next I
Repetitions = Repetitions & Temp
result = Left(result, iTemp - 1) & _
Mid(result, iTemp + 1)
Wend
End Function
After all, you will be able to use the function as formula in Excel, calling it as following for example:
=Repetitions(A2:F2)
I have some code I'm working on where I need to detect if a cell has a particular word in it, and if it does, it inserts a particular string in the adjacent cell. However, I'm having issues doing the detection part of it! Here's what I have so far.
Sub searchandpaste()
Dim stopvar As Variant
Dim i As Variant
Dim j As Variant
Dim k As Variant
Dim TestVal1 As Variant
Dim TestVal2 As Variant
i = 0
j = 0
Do While stopvar = 0
i = i + 1
MsgBox ("Row " & i)
MsgBox ("j equals " & j)
'If the first cell is empty, that means we've hit the end of the worksheet, and it stops the do-while loop
TestVal1 = Cells(i, 1)
If TestVal1 = 0 Then
stopvar = 1
Else
TestVal2 = Cells(i, 6)
If IsEmpty(TestVal2) = True Then
MsgBox ("Detected Empty Cell in Column 6")
j = 1
ElseIf TestVal2 = "XXXX" Then
'This means we have a place we need to insert a value
MsgBox ("Detected XXXX in Column 6")
'We know at this point that in Cells(6,i) we have a value we need to insert. Thus, we need to search Cells(7,i) for key text
If IsNumeric(Cells(7, j).Find("CYLINDER")) Or IsNumeric(Cells(7, j).Find("CYLINDERS")) Or IsNumeric(Cells(7, j).Find("CYL")) = True Then
MsgBox ("Detected the string CYLINDER")
j = j + 1
MsgBox ("j equals " & j)
Else
MsgBox ("Did not detect the string CYLINDER")
End If
End If
End If
Loop
End Sub
I'll cut out the important part, here.
'We know at this point that in Cells(6,i) we have a value we need to insert. Thus, we need to search Cells(7,i) for key text
If IsNumeric(Cells(7, j).Find("CYLINDER")) Or IsNumeric(Cells(7, j).Find("CYLINDERS")) Or IsNumeric(Cells(7, j).Find("CYL")) = True Then
MsgBox ("Detected the string CYLINDER")
j = j + 1
MsgBox ("j equals " & j)
Else
MsgBox ("Did not detect the string CYLINDER")
End If
My intention is that this would search the string in cell (i,7) for different variations of the word Cylinder, and if it finds one, it'll return TRUE or FALSE (false would be a NAN, which is caught by the IsNumeric and turned to a FALSE), and let me know it detected it. However, this doesn't seem to be working.
Can anybody pinpoint my error?
Is there a better way to search the string? Like, could I just search for "CYL" and have it say it detected any of those variations?
You should use the InStr function to do the comparison like this:
If InStr(1, Cells(7, j), "CYLINDER") > 0 Or _
InStr(1, Cells(7, j), "CYLINDERS") > 0 Or _
InStr(1, Cells(7, j), "CYL") > 0 Then
MsgBox ("Detected the string CYLINDER")
j = j + 1
MsgBox ("j equals " & j)
Else
MsgBox ("Did not detect the string CYLINDER")
End If
For more information on this function visit MSDN at https://msdn.microsoft.com/en-us/library/office/gg264811%28v=office.15%29.aspx
To avoid different cases (as suggested by #Sgdva) you have several options:
If InStr(1, Cells(7, j), "CYLINDER", vbTextCompare) > 0 Or _
InStr(1, Cells(7, j), "CYLINDERS", vbTextCompare) > 0 Or _
InStr(1, Cells(7, j), "CYL", vbTextCompare) > 0 Then
MsgBox ("Detected the string CYLINDER")
j = j + 1
MsgBox ("j equals " & j)
Else
MsgBox ("Did not detect the string CYLINDER")
End If
OR
If InStr(1, UCase(Cells(7, j)), "CYLINDER") > 0 Or _
InStr(1, UCase(Cells(7, j)), "CYLINDERS") > 0 Or _
InStr(1, UCase(Cells(7, j)), "CYL") > 0 Then
MsgBox ("Detected the string CYLINDER")
j = j + 1
MsgBox ("j equals " & j)
Else
MsgBox ("Did not detect the string CYLINDER")
End If
OR
Use the Option Compare Text at the top of your module and as pointed out here:
https://msdn.microsoft.com/en-us/library/office/gg278697.aspx
At the same time, you might want to consider inserting the line:
Option Explicit
(for good coding practice).
Not sure what you are trying to accomplish with the j variable as it doesn't seem to have any relevance. Except I seem to have identified an error in your code and the answer provided by Ralph. Cells(7, j) should rather be Cells(i, 7). Full code would be:
Sub searchandpaste()
Dim stopvar As Variant
Dim i As Variant
Dim j As Variant
Dim k As Variant
Dim TestVal1 As Variant
Dim TestVal2 As Variant
i = 0
j = 0
Do While stopvar = 0
i = i + 1
MsgBox ("Row " & i)
MsgBox ("j equals " & j)
'If the first cell is empty, that means we've hit the end of the worksheet, and it stops the do-while loop
TestVal1 = Cells(i, 1)
If TestVal1 = 0 Then
stopvar = 1
Else
TestVal2 = Cells(i, 6)
If IsEmpty(TestVal2) = True Then
MsgBox ("Detected Empty Cell in Column 6")
j = 1
ElseIf TestVal2 = "XXXX" Then
'This means we have a place we need to insert a value
MsgBox ("Detected XXXX in Column 6")
'We know at this point that in Cells(6,i) we have a value we need to insert. Thus, we need to search Cells(7,i) for key text
If InStr(LCase(Cells(i, 7)), "cyl") > 0 Then
MsgBox ("Detected the string CYLINDER")
j = j + 1
MsgBox ("j equals " & j)
Else
MsgBox ("Did not detect the string CYLINDER")
End If
End If
End If
Loop
End Sub