VBA: If given characters !, @ and # found in column B then put 1, 2 and 3 in respective cell in Column C

[azov5]

VBA: If given characters !, @ and # found in column B then put 1, 2 and 3 in respective cell in Column C
VBA: If given characters $, % and & found in column D then put 1, 2 and 3 in respective cell in Column E
Ps. Blank rows present in data

 

[mohadin]

Deleted Missing some thing

 

[Peter_SSs]

If given characters !, @ and # found in column B

Do you mean if all 3 are found, or just any one of them?

 

[mohadin]

Hi
I think this what you Want
Correct me if I'm wrong

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

 

[azov5]

Any one of them Peter if found.

 

[Peter_SSs]

Any one of them Peter if found.

Thanks. That then raises another question though.
What would go in column C if 2 or 3 of them are found in column B?

Example, what would go in column C if column B was
abc#23!Q

 

[azov5]

I actually din't thought about it. Thank you.
Then the output cell will be "1 and 3"

 

[mohadin]

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

[TABLE="width: 330"]
<colgroup><col span="2"><col><col></colgroup><tbody>[TR]
[TD] [/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]ab@c#23!Q[/TD]
[TD="align: left"]2 Then 3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]abc#23!Q[/TD]
[TD="align: left"]3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]abc#23!Q[/TD]
[TD="align: left"]3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]abc#23!Q[/TD]
[TD="align: left"]3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]abc#23!Q[/TD]
[TD="align: left"]3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]abc#23!Q[/TD]
[TD="align: left"]3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]abc#23!Q[/TD]
[TD="align: left"]3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]abc#23!Q[/TD]
[TD="align: left"]3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]ab@c#23!Q[/TD]
[TD="align: left"]2 Then 3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]abc#23!Q[/TD]
[TD="align: left"]3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]abc#23!Q[/TD]
[TD="align: left"]3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]abc#23!Q[/TD]
[TD="align: left"]3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD="align: left"]n@abc#23!Q[/TD]
[TD="align: left"]2 Then 3 Then 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[mohadin]

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

 

[Peter_SSs]

I actually din't thought about it. Thank you.
Then the output cell will be "1 and 3"

See if this is sufficient

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

Some sample data and code results

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