Move rows based on cell info
 

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

Move rows based on cell info
 

On Tuesday, October 30, 2012 10:21:44 AM UTC-5, kardifflad wrote:
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









--

kardifflad

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

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

i've actually worked out that each time i run the nacro it is moving half of the entires. so for instance if there are 100 entires with SCOT there then it moves 50 on the first press, 25 on the second, 13 on the third and so on.
Thats strange.

Move rows based on cell info
 

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

thats works perfectly. thank you very much. excellent