Trim or Len help (I think)

[Elaine]

In my worksheet I have two columns.

Column A contains (LAST name, FIRST name)
Column B contains (an ID number.)

I would like to change Column A to contain only the FIRST 4 letters of the
last name
I would like to change Column B to contain only the LAST 4 numbers of the ID
number

I have had some experience using Word VBA, but not that much in Excel. I do
want to do this using VBA because there are other steps that I need to take
also. I'd appreciate any help that I can get on this.

Elaine

 

[Jim May]

Insert helper column b for For Column A an enter in B =Left(A1,4)
Insert helper column d for your original Col b (which is now c) an enter in
D =Right(C1,4)
HTh

 

[RB Smissaert]

If you adjust this to your particular situation it will do the job.
Using an array will make it faster than looping through the cells.

Sub test()

Dim i As Long
Dim NameIDArray()

NameIDArray = Range(Cells(1), Cells(20, 2))

For i = 1 To 20
NameIDArray(i, 1) = Left(NameIDArray(i, 1), 4)
NameIDArray(i, 2) = Right(NameIDArray(i, 2), 4)
Next

Range(Cells(1), Cells(20, 2)) = NameIDArray

End Sub


RBS

 

[Greg Wilson]

Elaine,

My code takes into account that some names are less than 4
characters. Typically, these are Chinese names such
as "Eng", "Woo", "Ong" etc. My code also lets you set the
row number of the first cell in the range. Set the FirstRw
constant to this row. I have it currently set to row 5.

Const FirstRw As Integer = 5

Sub ShortenData()
Dim Rng As Range
Dim i As Long, LastRw As Long
Dim Pos As Integer
Dim LastNm As String

LastRw = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("A" & FirstRw & ":B" & LastRw)
For i = 1 To LastRw - FirstRw + 1
Pos = InStr(Rng(i, 1), ",")
If Pos > 0 Then
LastNm = Left(Rng(i, 1), Pos - 1)
Rng(i, 1) = Left(LastNm, Application.Min(Len(LastNm), 4))
End If
Next
For i = 1 To LastRw - FirstRw + 1
Rng(i, 2) = Right(Rng(i, 2), 4)
Next
End Sub

Regards,
Greg

 

[Greg Wilson]

A slightly shortened version:

Const FirstRw As Integer = 5

Sub ShortenData()
Dim Rng As Range
Dim i As Long, LastRw As Long
Dim Pos As Integer
Dim LastNm As String

LastRw = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("A" & FirstRw & ":B" & LastRw)
Rng.Select
For i = 1 To Rng.Count / 2
Pos = InStr(Rng(i, 1), ",")
If Pos > 0 Then
LastNm = Left(Rng(i, 1), Pos - 1)
Rng(i, 1) = Left(LastNm, Application.Min(Len(LastNm), 4))
End If
Rng(i, 2) = Right(Rng(i, 2), 4)
Next
End Sub

Regards,
Greg

 

[Elaine]

Thank you so much. That was exactly what I was looking for.

Elaine