Macro to delete consonants

------------------Deleted

5B:

Sub Test()
  With CreateObject("VBScript.RegExp")
    .Global = True
    .Ignorecase = True
    .Pattern = "[^a|e|i|o|u|\n]"
    If .Test([A1]) Then [C1] = .Replace([A1], "")
  End With
End Sub

@ karedog

Please put me out of my misery.....Assume that the information was in Column A1 down and not just in A1 so i.e A1 = "s", A2 = "s" A3 = "aiks" etc
How does this code have to be altered to work.

Option Explicit

Sub Cons_Del()
Dim n As Long
Dim i As Integer
Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lRow
   For n = 1 To Len("A" & i)
       If Not Range("A" & i).Characters(n, 1).Text Like "[a,e,i,o,u]" Then
          Range("A" & i).Characters(n, 1).Text = ""
        End If
    Next n
Next i
End Sub

Hi Norie

the characters in the string in Range("A" & i)

@ karedog

I was trying to make use of MickG's code for the post problem and could not even get that to work.

Option Explicit

Sub MickGCode()
Dim n
   For n = 1 To Len([a1])
       If Not Range("A1").Characters(n, 1).Text Like "[a,e,i,o,u]" Then
          Range("A1").Characters(n, 1).Text = ""
        End If
    Next n
End Sub

Are you sure you should be using Len("A" & i) in the inner loop?

@ Norie

I dunno...I'm lost....Being trying to figure out why !!!!

I'm trying to loop through A & i then loop through the characters of A & i

Is it the characters in the string A & i you want to loop through or the characters in the string in Range("A" & i)?

PS When deleting it's normally a good idea to loop backwards.

Oh my gosh...Really....Still so much to learn...Would never have figured that out...
So code that works if info was in column...Thanks Norie

Option Explicit

Sub Cons_Del()
Dim n As Long
Dim i As Integer
Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lRow
   For n = Len(Range("A" & i).Value) To 1 Step -1
       If Not Range("A" & i).Characters(n, 1).Text Like "[a,e,i,o,u]" Then
          Range("A" & i).Characters(n, 1).Text = ""
        End If
    Next n
Next i
End Sub

And MickG's code to solve the thread problem

Option Explicit

Sub MickGCode()
Dim n
   For n = Len([a1]) To 1 Step -1
       If Not Range("A1").Characters(n, 1).Text Like "[a,e,i,o,u]" Then
          Range("A1").Characters(n, 1).Text = ""
        End If
    Next n
End Sub

Originally Posted by jindon

Should be

    .Pattern = "[^aeiou\n]"

otherwise it leaves pipe.

Thanks for correction, forget it is inside square brackets.

Originally Posted by jindon

Should be

       If Not Range("A" & i).Characters(n, 1).Text Like "[aeiou]" Then

it also leaves comma.

Thanks jindon

So this,

Len("A" & i)

should be this.

Len(Range("A" & i).Value)

This UDF might work

Function RemoveCharacters(ByVal aString As String, Optional Characters As String, Optional CaseSensitive As Boolean = False) As String
    If Characters = vbNullString Then
        Characters = "bcdfghjklmnpqrstvwxyz" & "BCDFGHJKLMNPQRSTVWXYZ"
    End If
    Dim myChr As String: myChr = Chr(5)
    Dim strTest As String
    Dim workPoint As Long

    strTest = aString
    If Not CaseSensitive Then
        Characters = LCase(Characters)
        strTest = LCase(strTest)
    End If
    
    workPoint = 1
    
    Do Until workPoint > Len(strTest)
        Do While Mid(strTest, workPoint, 1) Like "[" & Characters & "]"
                Mid(strTest, workPoint, 1) = myChr
                Mid(aString, workPoint, 1) = myChr
                strTest = Replace(strTest, myChr, vbNullString)
                aString = Replace(aString, myChr, vbNullString)
        Loop
        workPoint = workPoint + 1
    Loop

    RemoveCharacters = aString
End Function

@sintek,
Sorry for the late, but I see you have figured it out by yoursef. Good job.

I would go for this one.

Sub Test()
  With CreateObject("VBScript.RegExp")
    .Global = True
    .Ignorecase = True
    .Pattern = "[^aeiou\n]"
    If .Test([A1]) Then [C1] = .Replace([A1], "")
  End With
End Sub