Move rows based on cell info

[kardifflad]

Hi.
I have this bit of code below that works fine for me save one bit. Th
code looks in column A for entries with the word "scotland". Where i
finds the word it then moves the entire row to a sheet called scotland.
However soon the entries will be semi numerical, so for instance coul
be SCOT1234. I therefore need the code to look for the 'scot' part an
then move those rows. i can't work out how to make it look for the firs
4 letters, or perhaps even just find the "s" at the start.
I am also thinking of adding another criteria for another country. so i
it was England it would look for the "E" and move those rows to a
England sheet. That bit should be easy enough though once i get thi
first bit.
can anyone help please?

Sub Sorting()

Dim sh2 As Worksheet, finalrow As Long
Dim i As Long, lastrow As Long
Set sh2 = Sheets("Scotland")
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To finalrow
If Cells(i, 1).Value = "Scotland" Then
lastrow = sh2.Cells(Cells.Rows.Count, 1).End(xlUp).Row
Cells(i, 1).EntireRow.Copy Destination:=sh2.Cells(lastrow + 1, 1)
Cells(i, 1).EntireRow.Delete
End If
Next i
End Su

 

[Don Guillett]

Hi.

I have this bit of code below that works fine for me save one bit. The

code looks in column A for entries with the word "scotland". Where it

finds the word it then moves the entire row to a sheet called scotland.

However soon the entries will be semi numerical, so for instance could

be SCOT1234. I therefore need the code to look for the 'scot' part and

then move those rows. i can't work out how to make it look for the first

4 letters, or perhaps even just find the "s" at the start.

I am also thinking of adding another criteria for another country. so if

it was England it would look for the "E" and move those rows to an

England sheet. That bit should be easy enough though once i get this

first bit.

can anyone help please?



Sub Sorting()



Dim sh2 As Worksheet, finalrow As Long

Dim i As Long, lastrow As Long

Set sh2 = Sheets("Scotland")

finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To finalrow

If Cells(i, 1).Value = "Scotland" Then

lastrow = sh2.Cells(Cells.Rows.Count, 1).End(xlUp).Row

Cells(i, 1).EntireRow.Copy Destination:=sh2.Cells(lastrow + 1, 1)

Cells(i, 1).EntireRow.Delete

End If

Next i

End Sub

Try
For i = 1 To finalrow
If ucase(left(Cells(i, 1),4)) = "SCOT" Then
rows(i).Copy sh2.Cells(sh2.rows.count, 1).end(xlup)(2)
rows(i).Delete
end if
next i

 

[kardifflad]

HI. and thank you. It works, but only sort of. For some reason it move
some but not all instances. But if i run the macro again then it move
some more, and so on. So in effect i have to run the macro about
times.
Any ideas please

 

[Ben McClave]

Hello,

I think that the reason you have to run it repeatedly is that when the row is deleted, the macro skips a row. Try this adjustment, where the cells are searched from the bottom up. That way, as rows are deleted, it won't skip any rows:

For i = finalrow to 1 Step -1

If ucase(left(Cells(i, 1),4)) = "SCOT" Then
rows(i).Copy sh2.Cells(sh2.rows.count, 1).end(xlup)(2)
rows(i).Delete
end if
next i

 

[kardifflad]

thats works perfectly. thank you very much. excellen