Archive data error in code

P

Patriot2879

Well-known Member
Joined
Feb 1, 2018
Messages
1,259
Office Version
  1. 2010
Platform
  1. Windows
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.
Code: 
lastrow = Sheets(“projects”).Range(“A” & Rows.Count).End(xlUp).Row

Code: 
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
 
Sort by date Sort by votes
Hi Goodmorning all, hope you can help with this query. I have the code below which is copying areas (Essex South, Essex Northand London) from ‘Admin Logger’ over to ‘Sheet2’.
How do I whencopying over to sheet2 to put Column B into date order?
Also whennew data is copied over on a daily basis to the last row in sheet2 to filter thewhole sheet into date order in from column B
Code: 
[FONT=Times New Roman][/FONT]
SubTransfer()
[FONT=Times New Roman][/FONT]
Dim i,lastrow
[FONT=Times New Roman][/FONT]
 Dim mytext As String
[FONT=Times New Roman][/FONT]
lastrow =Sheets("Admin_Logger").Range("A" &Rows.Count).End(xlUp).Row
[FONT=Times New Roman][/FONT]
 For i = 2 To lastrow
[FONT=Times New Roman][/FONT]
 mytext =Sheets("Admin_Logger").Cells(i, "J").Text
[FONT=Times New Roman][/FONT]
 If mytext = "Essex South" Or mytext= "Essex North" Or mytext = "London" Then
[FONT=Times New Roman][/FONT]
 Sheets("Admin_Logger").Cells(i,"A").EntireRow.Copy Destination:=Sheets("Sheet2 ").Range("A"& Rows.Count).End(xlUp).Offset(1)
[FONT=Times New Roman][/FONT]
 End If Next i
[FONT=Times New Roman][/FONT][FONT="Calibri"]End Sub[/FONT]



 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Hi I have tried amending to the code below but it seems not to work.
Code: 
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]SubTransfer()[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Dim i,lastrow[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Dim mytext As String[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#141414][FONT="inherit"]Dim TheDateNumber As Long[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#141414][FONT="inherit"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]lastrow =Sheets("Admin_Logger").Range("A" &Rows.Count).End(xlUp).Row[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]For i = 2 To lastrow[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]mytext =Sheets("Admin_Logger").Cells(i, "J").Text[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]If mytext = "Essex South" Or mytext= "Essex North" Or mytext = "London" Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Sheets("Admin_Logger").Cells(i,"A").EntireRow.Copy Destination:=Sheets("Sheet2 ").Range("A"& Rows.Count).End(xlUp).Offset(1)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#141414][FONT="inherit"]TheDateNumber = ThisWorkbook.Worksheets("[/FONT][/COLOR][FONT=Calibri][SIZE=3][COLOR=#000000]Sheet2[/COLOR][/SIZE][/FONT][COLOR=#141414][FONT="inherit"]").Range("B").Value[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#141414][FONT="inherit"]Rng.AutoFilter Field:=DateCol,Criteria1:="<=" & TheDateNumber, Operator:=xlAnd[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=#141414][FONT="inherit"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]End If Next i[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/CO[/COLOR][/SIZE][/FONT]DE]
 
Upvote 0
Hi I have also tried this code but its not filtering column B for me in date order from first to last.
Code: 
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]SubTransfer()[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Dim i, lastrow[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Dim mytext As String[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]lastrow =Sheets("Admin_Logger").Range("A" &Rows.Count).End(xlUp).Row[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]For i = 2 To lastrow[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]mytext =Sheets("Admin_Logger").Cells(i, "J").Text[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]If mytext = "Essex South" Or mytext= "Essex North" Or mytext = "London" Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Sheets("Admin_Logger").Cells(i,"A").EntireRow.Copy Destination:=Sheets("Sheet2").Range("A"& Rows.Count).End(xlUp).Offset(1)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]Worksheets("Sheet2").Range("B2").AutoFilter[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][SIZE=3][COLOR=#000000]End If[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Next i[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/CO[/COLOR][/SIZE][/FONT]DE]
 
Upvote 0
I hope you can help me please, basically what I am trying to do is when data is copied over to sheet2 I want column B to be filtered in date order oldest to newest, but the codes I have tried don't work unfortunately.
 
Upvote 0
HI I have also tried the code below to no avail.
Code: 
Sub Transfer()
 Dim i, LastRow
 Dim mytext As String
 Dim LR As Integer
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("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
LR = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Worksheets("Sie Lacey").Range("B2:Z" & LastRow).Sort _
Key1:=Worksheets("Sheet2").Columns("B"), Order1:=xlDescending, _
Key2:=Worksheets("Sheet").Columns("B"), Order2:=xlDescending, _
Header:=xlNo
 End If
 
Upvote 0
Hi I sort of got the code to work below but it is not updating the correct sheet I want it to update sheet2 but it is updating sheet1.
Code: 
[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("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)

With Range("A2:Q" & Cells(Rows.Count, "A").End(xlUp).Row)
    .Sort Key1:=Range("B2"), _
    Order1:=xlAscending, _
    Header:=xlNo, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortTextAsNumbers
End With
 End If/CODE]
 
Upvote 0
Hi I have also tried the code below as I have different sheets where I need to do the date order in column B, but still struggling. Please can you help
Code: 
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"]Sub Transfer()[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] Dim i, lastrow[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] Dim mytext As String[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"]Set sh1 = Sheets("Sheet2")[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"]Set sh2 = Sheets("Sheet3")[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"]lastrow =Sheets("Admin_Logger").Range("A" &Rows.Count).End(xlUp).Row[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] For i = 2 To lastrow[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] mytext =Sheets("Admin_Logger").Cells(i, "J").Text[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] If mytext = "Essex South" Or mytext= "Essex North" Or mytext = "London" Then[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] Sheets("Admin_Logger").Cells(i,"A").EntireRow.Copy Destination:=Sheets("Sheet2").Range("A"& Rows.Count).End(xlUp).Offset(1)[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"]End If[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] If mytext = "County Durham" Ormytext = "Yorkshire North" Or mytext = "Yorkshire West"Then[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] Sheets("Admin_Logger").Cells(i,"A").EntireRow.Copy Destination:=Sheets("Sheet3").Range("A"& Rows.Count).End(xlUp).Offset(1)[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] End If[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] Next i[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"]sh1.Range("A" &Rows.Count).End(xlUp).Sort sh1.Range("B2"), xlAscending[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"]sh2.Range("A" &Rows.Count).End(xlUp).Sort sh2.Range("B2"), xlAscending[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"] [/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][COLOR=black][FONT="Courier New"]End Sub[/FONT][/COLOR]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/CO[/COLOR][/SIZE][/FONT]DE]
 
Upvote 0
Hi hope you can help please. I have tried different codes of internet but cant get them to work. Your help is much appreciated. Thank you.
 
Upvote 0
Hi good morning hope you can help me please or do I need to start a new topic?
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
Auto-Archive deleted Rows in Excel
2 3 4
Replies
30
Views
1K
liljunga
L
T
  • Solved
Find #REF! errors in multiple tables and delete those rows
Replies
7
Views
278
Peter_SSs
Peter_SSs
D
  • Solved
Error 1004
2
Replies
18
Views
352
dmt32
D
C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
183
NdNoviceHlp
NdNoviceHlp
S
  • Question Question
Searching Sheet Names using a wildcard
Replies
5
Views
289
mumps
mumps

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top