Formula or VBA

[Brentsa]

Good day,

I'm a newbie to VBA but have gotten help previously with a VBA formula it it makes everything so much easier. so I was wondering if I could get help.

In column C of my spreadsheet I have display names:

Mrs MAT Schnetler
Mr J Smith
Ms AD Adams
Mrs ASDLK Botha

I have used the following three formulas:
=RIGHT(C1,LEN(C1)-FIND(" ",C1)) - to get rid of the salutations
=LEFT(D2,FIND(" ",D2,1)-1) - to get rid of surname
=SUBSTITUTE(TRIM(MID(E1,1,1)&" "&MID(E1,2,1)&" "&MID(E1,3,1)&" "&MID(E1,4,1))," "," ") - to add a space between the initial letters.

so my results are:
M A T
J
A D
A S D L K

However I ended up creating three extra columns D,E.F in my spreadsheet then copy and pasting my final result in Column F and paste special as Values in column D then delete column E and F.

So I would like to either combine all three formulas or better yet create a VBA string so that it can do it all.

 

[maabadi]

Try this with VBA

Sub Extract2()
Dim i As Long, Lr As Long, A As String, B As String, C As String, L As Long, D As String, E As String, j As Long
Lr = Range("C" & Rows.Count).End(xlUp).Row
For i = 1 To Lr
A = Right(Range("C" & i).Value, Len(Range("C" & i).Value) - Application.WorksheetFunction.Find(" ", Range("C" & i).Value))
B = Left(A, Application.WorksheetFunction.Find(" ", A) - 1)
L = Len(B)
E = Left(B, 1)
For j = 2 To L
C = Mid(B, j, 1)
D = Replace(C, C, " " & C)
E = E & D
Next j
Debug.Print E
Next i
End Sub

And this with Formula

=SUBSTITUTE(TRIM(MID(LEFT(RIGHT(C1,LEN(C1)-FIND(" ",C1)),FIND(" ",RIGHT(C1,LEN(C1)-FIND(" ",C1)),1)-1),1,1)&" "&MID(LEFT(RIGHT(C1,LEN(C1)-FIND(" ",C1)),FIND(" ",RIGHT(C1,LEN(C1)-FIND(" ",C1)),1)-1),2,1)&" "&MID(LEFT(RIGHT(C1,LEN(C1)-FIND(" ",C1)),FIND(" ",RIGHT(C1,LEN(C1)-FIND(" ",C1)),1)-1),3,1)&" "&MID(LEFT(RIGHT(C1,LEN(C1)-FIND(" ",C1)),FIND(" ",RIGHT(C1,LEN(C1)-FIND(" ",C1)),1)-1),4,1))," "," ")

 

[Brentsa]

Formula works perfectly.

VBA code does not but it could be something that I am doing..

 

[maabadi]

Sorry. I forgot to add result to Excel window it shows results at immediate window Try this

Sub Extract2()
Dim i As Long, Lr As Long, A As String, B As String, C As String, L As Long, D As String, E As String, j As Long
Lr = Range("C" & Rows.Count).End(xlUp).Row
For i = 1 To Lr
A = Right(Range("C" & i).Value, Len(Range("C" & i).Value) - Application.WorksheetFunction.Find(" ", Range("C" & i).Value))
B = Left(A, Application.WorksheetFunction.Find(" ", A) - 1)
L = Len(B)
E = Left(B, 1)
For j = 2 To L
C = Mid(B, j, 1)
D = Replace(C, C, " " & C)
E = E & D
Next j
Range("D" & i).Value = E
Next i
End Sub

 

[Brentsa]

Sorry. I forgot to add result to Excel window it shows results at immediate window Try this

Sub Extract2()
Dim i As Long, Lr As Long, A As String, B As String, C As String, L As Long, D As String, E As String, j As Long
Lr = Range("C" & Rows.Count).End(xlUp).Row
For i = 1 To Lr
A = Right(Range("C" & i).Value, Len(Range("C" & i).Value) - Application.WorksheetFunction.Find(" ", Range("C" & i).Value))
B = Left(A, Application.WorksheetFunction.Find(" ", A) - 1)
L = Len(B)
E = Left(B, 1)
For j = 2 To L
C = Mid(B, j, 1)
D = Replace(C, C, " " & C)
E = E & D
Next j
Range("D" & i).Value = E
Next i
End Sub

the first entry in is line 2 does this make a difference?

 

[mohadin]

Hi
What about

Sub test()
    Dim a, c As Variant
    Dim i, ii As Long
    a = Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
    For i = 1 To UBound(a)
        c = Split(a(i, 1))
        For ii = 1 To Len(c(1)) * 2 Step 2
            a(i, 1) = WorksheetFunction.Substitute(c(1), Mid(c(1), ii, 1), Mid(c(1), ii, 1) & " ")
            c(1) = a(i, 1)
        Next
    Next
    Range("D1").Resize(UBound(a)) = a
End Sub

 

[Brentsa]

Hi
What about

Sub test()
    Dim a, c As Variant
    Dim i, ii As Long
    a = Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
    For i = 1 To UBound(a)
        c = Split(a(i, 1))
        For ii = 1 To Len(c(1)) * 2 Step 2
            a(i, 1) = WorksheetFunction.Substitute(c(1), Mid(c(1), ii, 1), Mid(c(1), ii, 1) & " ")
            c(1) = a(i, 1)
        Next
    Next
    Range("D1").Resize(UBound(a)) = a
End Sub

this vba works

 

[maabadi]

the first entry in is line 2 does this make a difference?

Change I= 1 to Lr to

For i=2 to Lr

 

[mohadin]

Glad I could help
Thank you for the feedback
Be happy & safe