# Compare first characters in two cells

D

#### drjohnwilliams

I have a spreadsheet of surnames in alphabetical order. As these were
OCR'd some of the entries got split into two cells e.g. This would be a
typical list:

Robert

The split is random so one can't select every nth cell

As this is over 35K rows long. I am trying to move those split names
such as Robert to an adjacent cell to the right of the correct name. So
after processing it would look like:

I thought the best way to do this would be to start at the top of the
column, read the first character in the cell e.g. A, (Adams John Jones)
go down a line and read the next first character R (Robert)and compare.
If the two characters are the same then I would compare the second one
R (Robert) with the next one down; A (Adams Michael). If they were
different then I would move the second entry Robert up and across one
row. Go back to the column and down a row to avoid the now blank cell
and compare two cells again until the end is reached.

I am having real problems in figusring out how to select just the first
character in a cell and then compare it with another.
Thanks

john

s1 = Ucase(left(cells(i-1,1).Value,1))
s2 = Ucase(left(cells(i,1).Value,1))
s3 = Ucase(left(cells(i+1,1).Value,1))

or you can use mid
s1 = Ucase(Mid(cells(i-1,1).Value,1,1))
s2 = Ucase(Mid(cells(i,1).Value,1,1))
s3 = Ucase(Mid(cells(i+1,1).Value,1,1))

I hope the following macro may help

Because of the logic in your question, your list should contain at least 3 rows of names

To use the macro, you just have to have any one of the cells in your list selected

'--------------------------------------------
Sub move_names(
Dim tmp As Singl
With Selection.CurrentRegion.Columns(1
If .Cells.Count >= 3 The
For tmp = .Cells.Count To 3 Step -
If Asc(Left(.Cells(tmp - 1).Value, 1)) > Asc(Left(.Cells(tmp).Value, 1)) The
.Cells(tmp - 2).Value = .Cells(tmp - 2).Value & " " & .Cells(tmp - 1).Valu
.Cells(tmp - 1).EntireRow.Delet
End I
Nex
End I
End Wit
End Su
'--------------------------------------------

Regards
Edwin Ta
http://www.vonixx.com

----- drjohnwilliams > wrote: ----

I have a spreadsheet of surnames in alphabetical order. As these wer
OCR'd some of the entries got split into two cells e.g. This would be
typical list

Rober

The split is random so one can't select every nth cel

As this is over 35K rows long. I am trying to move those split name
such as Robert to an adjacent cell to the right of the correct name. S
after processing it would look like

I thought the best way to do this would be to start at the top of th
column, read the first character in the cell e.g. A, (Adams John Jones
go down a line and read the next first character R (Robert)and compare
If the two characters are the same then I would compare the second on
R (Robert) with the next one down; A (Adams Michael). If they wer
different then I would move the second entry Robert up and across on
row. Go back to the column and down a row to avoid the now blank cel
and compare two cells again until the end is reached.

I am having real problems in figusring out how to select just the firs
character in a cell and then compare it with another.
Thank

joh

Thanks to you both for the ideas. I did try Edwin's macro on th
following list:

STANLEY, Charles James
Stanley, Charles Vivian
Beresford
Stanley, Edmund Hamilton Blake.
Stanley, Ernest Gerald
Stanley, George Wheldale
Albert
Stanley, Herbert Vernon
STANLEY, Hubert

But the result ended up with the first cell having the first 6 entrie
and then the last three remained as they were.
It should have shown:
STANLEY, Charles James
Stanley, Charles Vivian Beresford
Stanley, Edmund Hamilton Blake.
Stanley, Ernest Gerald
Stanley, George Wheldale Albert
Stanley, Herbert Vernon
STANLEY, Hubert

Can't quite see what to do to alter the code. Any thoughts?

Thanks

Try the following modified macro

'--------------------------------
Sub move_names(
Dim tmp As Singl
With Selection.CurrentRegion.Columns(1
If .Cells.Count >= 3 The
For tmp = .Cells.Count To 3 Step -
If Asc(Left(.Cells(tmp - 1).Value, 1)) <> Asc(Left(.Cells(tmp).Value, 1)) And InStr(Trim(.Cells(tmp - 1).Value), " ") = 0 The
.Cells(tmp - 2).Value = .Cells(tmp - 2).Value & " " & .Cells(tmp - 1).Valu
.Cells(tmp - 1).EntireRow.Delet
End I
Nex
End I
End Wit
End Su
'---------------------------------------------

Regards
Edwin Ta
http://www.vonixx.co

Edwin,

That worked a lot better but it did not move all the entries and
can't see why it should have left them.

Some of the entries had a comma after the first name, but even whe
this was removed there was still no change.
I should have said that the data was in Column C as even when
highlighted that column it did alter column A data.

Can't see a pattern as to why some entries are left and others moved a
it clearly has moved successfully quite a lot of them and saved me
lot of time.The following is a typical example of what was not move
The first column is a cell number and the second is the publication
the third is the data I am working on.

9415 Medical_0380.tif Daniels Isaac Khan
9416 Medical_0380.tif Loghumael Attiba
9417 Medical_0380.tif Daniels Thomas Francis
9418 Medical_0380.tif Danks Robert Miller

I did discover that a Cot followed by a Charles in the next row clearl
left the Charles as the two started with the same letter C. If I wante
to compare more that one letter say 2 or 3 what would be the easies
way to do this?

Thanks for your help and patience
Joh

John,

Your data seemed more complex than I expected. The following macro scans your data twice to try to ensure all data are properly moved.
However, this time, you need to first select all the cells (containing the names) you want to scan. And then run the macro.
Let me know if you have further problem.

'---------------------------------
Sub move_names()
Dim tmp As Single, counter As Single
If Selection.Areas.Count > 1 Then Exit Sub
If .Cells.Count >= 3 Then
For tmp = .Cells.Count To 3 Step -1
If Asc(Left(.Cells(tmp - 1).Value, 1)) <> Asc(Left(.Cells(tmp).Value, 1)) And InStr(Trim(.Cells(tmp - 1).Value), " ") = 0 Then
.Cells(tmp - 2).Value = .Cells(tmp - 2).Value & " " & .Cells(tmp - 1).Value
.Cells(tmp - 1).EntireRow.Delete
counter = counter + 1
End If
Next
End If
With .Resize(.Rows.Count - counter, 1)
If .Cells.Count >= 3 Then
For tmp = .Cells.Count To 3 Step -1
If InStr(Trim(.Cells(tmp - 1).Value), " ") = 0 Then
.Cells(tmp - 2).Value = .Cells(tmp - 2).Value & " " & .Cells(tmp - 1).Value
.Cells(tmp - 1).EntireRow.Delete
counter = counter + 1
End If
Next
End If
End With
End With
End Sub
'----------------------------------------------

Regards,
Edwin Tam