CODEWITHSUNDEEP
excelvba
GenjutsuGhost
GenjutsuGhost

Reputation: 47

Adding the first letters of multiple names in Column B

I got this code from another user in this forum (thank you so much).

Now I'm looking to edit it so that I don't have to select a specific column.

So what I want with this code, is that for every name in column C (even second, third, fourth, 5th names), the code needs to grab the first letters and add a dot, and place it inside column B.

For example: S.A.F.G.H. (5 first letters of surnames)

Dim cell As Range
    For Each cell In Selection
                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

Thanks in advance!

Upvotes: 1

Views: 64

Answers (2)

VBA Pete
VBA Pete

Reputation: 2666

You could change Selection to ActiveSheet.Range("C:C"):

Sub Test()
Dim cell As Range
Dim LastRow As Long

LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row

For Each cell In ActiveSheet.Range("C2:C" & 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

End Sub

Upvotes: 1

FaneDuru
FaneDuru

Reputation: 42246

Please, try this way:

Sub testGrabNames()
 Dim sh As Worksheet, rng As Range, lastRow As Long, cell As Range, V, W, S As String

 Set sh = ActiveSheet
 lastRow = sh.Range("C" & rows.count).End(xlUp).row
 Set rng = sh.Range("C2:C" & lastRow)

 For Each cell In rng
    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
End Sub

Upvotes: 1

Related Questions