CODEWITHSUNDEEP
excelvba
Ulquiorra Schiffer
Ulquiorra Schiffer

Reputation: 89

Creating first letters of names based on if there are already first letters and add a dot

I hope someone can help me with this complicated question tho!

This code checks the names in column E, then creates for each name in column E a first letter in column D and adds an dot.

For example if there is a name called Dave in column E it creates D. in column D.

For exmaple if there is a name called Dave Rick in column E it create D.E. in column D.

So what I would like to change in this code is that if there is already a firstletter or second or third in column D then it should not do anything besides putting a dot. If there isn't one and if there is not a firstletter in column E, it should automatically put the first letters of the names in column E in column D with a dot.

Dim cell As Range

lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row

For Each cell In ActiveSheet.Range("E2:E" & lastRow)
    S = ""
    If cell.Value <> "" Then
        V = Split(cell.Value, " ")
        For Each W In V
            S = S & Left$(W, 1) & "."
        Next W
        cell.Offset(ColumnOffset:=-1).Value = S
    End If
Next cell

Screenshot:

Example:

Extra screenshot:

enter image description here

Upvotes: 0

Views: 169

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57743

If your cell contains a value just replace spaces with dots and append one dot in the end.

For Each cell In ActiveSheet.Range("E2:E" & lastRow)
    S = ""
    If ActiveSheet.Range("B" & cell.Row) <> "" Then 'Adjust "B" to be the column with the initials
        'If initals exist re-format them with dots.
        Dim FixValue As String
        FixValue = cell.Value
        FixValue = Replace$(FixValue , ". ", ".") 'this will turn `D. Z. K.` into `D.Z.K.` as the other patterns
        FixValue = Replace$(FixValue , " ", ".") & "." 'this will turn `D Z K` into `D.Z.K.`
        cell.Value = FixValue 
    ElseIf cell.Value <> "" Then
        'If no initals exist but a first name exists then turn name into initials
        V = Split(cell.Value, " ")
        For Each W In V
            S = S & Left$(W, 1) & "."
        Next W
        cell.Offset(ColumnOffset:=-1).Value = S
    End If
Next cell

That's it.

Upvotes: 3

Related Questions