Archive data error in code

[Patriot2879]

Hi Good morning, I hope you can help me I have a command button once clicked on it should archive the old data that has 'delivered' in a cell. But I get an error 'Run time error 9 - subscript out of range' on the line below, please also see the whole code below, hope you can help.

lastrow = Sheets(“projects”).Range(“A” & Rows.Count).End(xlUp).Row

Sub archive()
 Dim i, lastrow
 Dim mytext As String
lastrow = Sheets(“projects”).Range(“A” & Rows.Count).End(xlUp).Row
 For i = 2 To lastrow
 mytext = Sheets(“projects”).Cells(i, “C”).Text
 If InStr(mytext, “delivered”) Then
 Sheets(“projects”).Cells(i, “A”).EntireRow.Copy Destination:=Sheets(“delivered”).Range(“A” & Rows.Count).End(xlUp).Offset(1)
 Sheets(“projects”).Cells(i, “A”).EntireRow.Delete
 End If
 Next i
End Sub

 

[stumac]

Re: Archive data error in code please help

Looks like your quotation marks are wrong throughout -

“

instead of

"

If you replace all of them to the correct one the code appears to run as intended.

 

[Patriot2879]

Re: Archive data error in code please help

that's great thankyou, could you advise how I can add an additonal word? I want it to look for 'delivered' and 'not delivered'.

 

[stumac]

Re: Archive data error in code please help

Just now it is lookiing for any value including delivered - therefore not delivered would be picked up.

An issue you will face is starting from the top down means some rows wont be checked.

if you check row 2 then delete row 2, row 3 becomes row 2 and wont be rechecked. you should start from the bottom and work up.

Sub archive() Dim i, lastrow
 Dim mytext As String
lastrow = Sheets("projects").Range("A" & Rows.Count).End(xlUp).Row
 For i = lastrow To 2 Step -1
 mytext = Sheets("projects").Cells(i, "C").Text
 If InStr(mytext, "delivered") Then
 Sheets("projects").Cells(i, "A").EntireRow.Copy Destination:=Sheets("delivered").Range("A" & Rows.Count).End(xlUp).Offset(1)
 Sheets("projects").Cells(i, "A").EntireRow.Delete
 End If
 Next i
End Sub

 

[Patriot2879]

Re: Archive data error in code please help

Hi Stumac thank you for your help and the updated code to step back and recheck the lines that is great and much appreciated. what if I wanted to changed the word to 'Yes' and 'No' how could I do that please?

 

[stumac]

Re: Archive data error in code please help

Using the method you are using you would just check mytext for the values:

Option Compare Text


Sub archive()
 Dim i, lastrow
 Dim mytext As String
lastrow = Sheets("projects").Range("A" & Rows.Count).End(xlUp).Row


 For i = lastrow To 2 Step -1
    mytext = Sheets("projects").Cells(i, "C").Text
    If mytext = "Yes" Or mytext = "No" Then
        Sheets("projects").Cells(i, "A").EntireRow.Copy Destination:=Sheets("delivered").Range("A" & Rows.Count).End(xlUp).Offset(1)
        Sheets("projects").Cells(i, "A").EntireRow.Delete
    End If
 Next i
End Sub

Note the 'Option Compare Text' statement, this will make text comparisons case insensitive (Yes, YES, yes) would all be picked up.

 

[Patriot2879]

Re: Archive data error in code please help

That's fantastic thank you so much for your help on this

 

[Patriot2879]

Re: Archive data error in code please help

Hi good morning all, I have got the code working but trying to amend it a little so it adds data to different sheets but its getting an error, please can you advise the code is below.

Sub Transfer()
 Dim i, lastrow
 Dim mytext As String
lastrow = Sheets("Admin_Logger").Range("A" & Rows.Count).End(xlUp).Row
 For i = 2 To lastrow
 mytext = Sheets("Admin_Logger").Cells(i, "J").Text
 If mytext = "Essex South" Or mytext = "Essex North" Or mytext = "London" Then
 Sheets("Admin_Logger").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)

 If mytext = "Buckinghamshire" Or mytext = "Stevenage" Or mytext = "Herts" Then
 Sheets("Admin_Logger").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)

 If mytext = "Cambridge" Or mytext = "Lincs South" Or mytext = "Northants" Then
 Sheets("Admin_Logger").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1)


 End If
 Next i
End Sub

 

[stumac]

Re: Archive data error in code please help

what is the error?

again you are going from top to bottom, you will eventually run in to blank lines and some rows will not be tested.

 

[Patriot2879]

I fixed it now I didnt put end if in the blank lines it now works Thanks for getting back to me