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

azov5

New Member
Joined
Dec 27, 2018
Messages
29
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
 

Some videos you may like

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
Deleted Missing some thing
 
Last edited:

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
Hi
I think this what you Want
Correct me if I'm wrong
Code:
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
 
Last edited:

azov5

New Member
Joined
Dec 27, 2018
Messages
29
Any one of them Peter if found.
 
Last edited:

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
43,719
Office Version
365
Platform
Windows
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

New Member
Joined
Dec 27, 2018
Messages
29
I actually din't thought about it. Thank you.
Then the output cell will be "1 and 3"
 

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
Code:
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
BC
ab@c#23!Q2 Then 3 Then 1
abc#23!Q3 Then 1
abc#23!Q3 Then 1
abc#23!Q3 Then 1
abc#23!Q3 Then 1
abc#23!Q3 Then 1
abc#23!Q3 Then 1
abc#23!Q3 Then 1
ab@c#23!Q2 Then 3 Then 1
abc#23!Q3 Then 1
abc#23!Q3 Then 1
abc#23!Q3 Then 1
n@abc#23!Q2 Then 3 Then 1

<colgroup><col span="2"><col><col></colgroup><tbody>
</tbody>
 
Last edited:

mohadin

Active Member
Joined
Mar 22, 2015
Messages
361
Office Version
2013
Platform
Windows
Code:
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
43,719
Office Version
365
Platform
Windows
I actually din't thought about it. Thank you.
Then the output cell will be "1 and 3"
See if this is sufficient

Rich (BB code):
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
BCDE
1
2abc@ d!f#1 and 2 and 3abc$ gft&gh%1 and 2 and 3
3123@2assa
4
5#dfre3d%2
6ccxc%d2
7$34&fdr1 and 3
Find Characters
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,090,457
Messages
5,414,637
Members
403,539
Latest member
rthompsona

This Week's Hot Topics

Top