Do you mean if all 3 are found, or just any one of them?If given characters !, @ and # found in column B
Sub Clo_B()
Application.ScreenUpdating = False
Dim a As Variant, m, i, lr, t, arr, o1
o1 = "!@#"
lr = Cells(Rows.Count, 2).End(xlUp).Row
ReDim a(1 To lr)
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\!|@|#"
For t = 1 To lr
If .test(Cells(t, 2)) Then
Set m = .Execute(Cells(t, 2))
Cells(t, 3) = InStr(1, o1, m(0), vbBinaryCompare)
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Sub Clo_D()
Application.ScreenUpdating = False
Dim a As Variant, m, i, lr, t, arr, o1
o1 = "$%&"
lr = Cells(Rows.Count, 4).End(xlUp).Row
ReDim a(1 To lr)
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\$|%|&"
For t = 1 To lr
If .test(Cells(t, 4)) Then
Set m = .Execute(Cells(t, 4))
Cells(t, 5) = InStr(1, o1, m(0), vbBinaryCompare)
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Thanks. That then raises another question though.Any one of them Peter if found.
Sub Clo_B()
Application.ScreenUpdating = False
Dim a As Variant, m, i, lr, t, arr, o1, x
o1 = "!@#"
lr = Cells(Rows.Count, 2).End(xlUp).Row
ReDim a(1 To lr)
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\!|@|#"
For t = 1 To lr
If .test(Cells(t, 2)) Then
Set m = .Execute(Cells(t, 2))
ReDim x(0 To m.Count - 1)
For i = 0 To m.Count - 1
x(i) = InStr(1, o1, m(i), vbBinaryCompare)
Next i
Cells(t, 3) = Join(x, " Then ")
End If
Next
End With
Application.ScreenUpdating = True
End Sub
B | C | ||
ab@c#23!Q | 2 Then 3 Then 1 | ||
abc#23!Q | 3 Then 1 | ||
abc#23!Q | 3 Then 1 | ||
abc#23!Q | 3 Then 1 | ||
abc#23!Q | 3 Then 1 | ||
abc#23!Q | 3 Then 1 | ||
abc#23!Q | 3 Then 1 | ||
abc#23!Q | 3 Then 1 | ||
ab@c#23!Q | 2 Then 3 Then 1 | ||
abc#23!Q | 3 Then 1 | ||
abc#23!Q | 3 Then 1 | ||
abc#23!Q | 3 Then 1 | ||
n@abc#23!Q | 2 Then 3 Then 1 | ||
Sub Clo_B_nd_D()
Application.ScreenUpdating = False
Dim a As Variant, m, i, lr, t, arr, o1, x
o1 = "!@#"
o2 = "$%&"
lr = Cells(Rows.Count, 2).End(xlUp).Row
ReDim a(1 To lr)
With CreateObject("VBScript.RegExp")
.Global = True
For t = 1 To lr
.Pattern = "\!|@|#"
If .test(Cells(t, 2)) Then
Set m = .Execute(Cells(t, 2))
ReDim x(0 To m.Count - 1)
For i = 0 To m.Count - 1
x(i) = InStr(1, o1, m(i), vbBinaryCompare)
Next i
Cells(t, 3) = Join(x, " Then ")
End If
.Pattern = "\$|%|&"
If .test(Cells(t, 4)) Then
Set m = .Execute(Cells(t, 4))
ReDim x(0 To m.Count - 1)
For i = 0 To m.Count - 1
x(i) = InStr(1, o2, m(i), vbBinaryCompare)
Next i
Cells(t, 5) = Join(x, " Then ")
End If
Next
End With
Application.ScreenUpdating = True
End Sub
See if this is sufficientI actually din't thought about it. Thank you.
Then the output cell will be "1 and 3"
Sub FindCharacters()
With Range("B2", Range("B" & Rows.Count).End(xlUp))
.Offset(, 1).Value = Evaluate(Replace("mid(if(isnumber(find(""!"",?)),"" and 1"","""")&if(isnumber(find(""@"",?)),"" and 2"","""")&if(isnumber(find(""#"",?)),"" and 3"",""""),6,99)", "?", .Address))
End With
With Range("D2", Range("D" & Rows.Count).End(xlUp))
.Offset(, 1).Value = Evaluate(Replace("mid(if(isnumber(find(""$"",?)),"" and 1"","""")&if(isnumber(find(""%"",?)),"" and 2"","""")&if(isnumber(find(""&"",?)),"" and 3"",""""),6,99)", "?", .Address))
End With
End Sub
Excel Workbook | ||||||
---|---|---|---|---|---|---|
B | C | D | E | |||
1 | ||||||
2 | abc@ d!f# | 1 and 2 and 3 | abc$ gft&gh% | 1 and 2 and 3 | ||
3 | 123@ | 2 | assa | |||
4 | ||||||
5 | #dfre | 3 | d% | 2 | ||
6 | ccxc | %d | 2 | |||
7 | $34&fdr | 1 and 3 | ||||
Find Characters |