Multiple names in a loop

[Benny Howard]

Here is my macro. My problem I have several names and mutiple locations in a state. So, I would prefer to not, have to copy and paste this macro and insert a new name or office location on each one. I want to use the one macro, but be able to list several names in it and allow it to fill in for each name or location.

example: Bob, jane, tom belong in "X" office, in "X" State, in "X"region, in "X" division.

I hope you understand what I am trying to do and thanks.

ub FillinLeftBlanks()
Columns("A:E").Select
Selection.Replace What:="", Replacement:="fillin", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Dim i As Integer
Range("e1").Select
Do Until ActiveCell = ""
i = InStr(1, ActiveCell, "CHARLES SEMENTE")
If i > 0 Then
ActiveCell.Offset(0, -1).Select
ActiveCell = "WOODBRIDGE"
ActiveCell.Offset(0, 1).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("d1").Select
Do Until ActiveCell = ""
i = InStr(1, ActiveCell, "WOODBRIDGE")
If i > 0 Then
ActiveCell.Offset(0, -1).Select
ActiveCell = "NEW JERSEY"
ActiveCell.Offset(0, 1).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("c1").Select
Do Until ActiveCell = ""
i = InStr(1, ActiveCell, "NEW JERSEY")
If i > 0 Then
ActiveCell.Offset(0, -1).Select
ActiveCell = "EAST 1"
ActiveCell.Offset(0, 1).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("b1").Select
Do Until ActiveCell = ""
i = InStr(1, ActiveCell, "EAST 1")
If i > 0 Then
ActiveCell.Offset(0, -1).Select
ActiveCell = "EAST"
ActiveCell.Offset(0, 1).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
Range("e1").Select

ray: