I need a macro to do the following….

Macro for trimming the extra spaces and concatenating  Lastname and initials of given names

If last name is in column A and given names in column B

if I put this in column C

=TRIM(A1) &” , “&TRIM(LEFT(B1,1)&IF(ISERROR(FIND(” “,B1,1)),””,MID(B1,FIND(” “,B1,1)+1,1))&IF(ISERROR(FIND(” “,B1,FIND(” “,B1,1)+1)),””,MID(B1,FIND(” “,B1,FIND(” “,B1,1)+1)+1,1)))

I am getting  BRAGANZA  , GBJ

If I delete the columns A and B, then the column C becomes blank!

But, I want to make it look like this.

BRAGANZA                         GERARD BERNARD JOSEPH                          Braganza, GBJ

EDWARDS                           PHILLIP JON                                                        Edwards, PJ

SMITH                                   DANNY STUART                                                Smith, DS

MCKEOWN                         TERRY DESMOND                                             McKeown, TD

KEAR                                     DAVID ANDREW                                               Kear, DA

WARD                                   STEPHEN CHARLES                                           Ward, SC

Then I want to delete Column A and column B.

Top Contributor Asked on May 12, 2017 in Excel.
Add Comment
3 Answer(s)

HI,

Before deleting Column A and Column B copy 3rd column  data and paste as special values. Now delete Column A and Column B.

Regards!

Expert Answered on May 12, 2017.
Add Comment

Thank sorted out…

Top Contributor Answered on May 13, 2017.
Add Comment

 

Sub ConcatenateSurnameAndInitials()
'Concatenates initials from given names (column 2) to proper surname in column 3
Dim a, j As Long
With Cells(1).CurrentRegion.Resize(, 3)
a = .Value
For j = 1 To UBound(a, 1)
a(j, 3) = Trim$(StrConv(a(j, 1), 3)) & IIf(a(j, 2) <> "", ", ", "") & GetInitial(a(j, 2))
Next
.Value = a
End With
End Sub
ials from given names (column 2) to proper surname in column 3
Dim a, j As Long
With Cells(1).CurrentRegion.Resize(, 3)
a = .Value
For j = 1 To UBound(a, 1)
a(j, 3) = Trim$(StrConv(a(j, 1), 3)) & IIf(a(j, 2) <> "", ", ", "") & GetInitial(a(j, 2))
Next
.Value = a
End With
End Sub

 

Function GetInitial(ByVal txt As String) As String
Dim m
With CreateObject("VBScript.RegExp")
.Global = True: .IgnoreCase = True
.Pattern = "\b[A-Z]"
For Each m In .Execute(txt)
GetInitial = GetInitial & m
Next
End With
End Function
Top Contributor Answered on May 13, 2017.
Add Comment
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.