PDA

View Full Version : [SOLVED] Moving Rows



mykal66
01-07-2020, 08:16 AM
I’m setting up a planner at work and want any meetings thatare in the past to be moved to another worksheet when the file is opened.
I’ve found some code elsewhere (below) which I have tried toadapt but can’t get it to work. Cananyone see what I haven’t changed correctly please?
The main TAB is Forward Look Planner and the dates in in ColumnC (Starting C4). The second other TAB iscalled Archived.
This is the code I have tried to change but it doesn’t work!
As always, thank you for any help.
Mykal

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheets("Forward Look Planner").Activate
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrowa = Sheets("Archived").Cells(Rows.Count, "A").End(xlUp).Row + 1
Dim c As Long
Dim s As Variant
c = 3 ' Column Number Modify this to your need
s = "<" & Date 'Search Value Modify to your need
Lastrow = Cells(Rows.Count, c).End(xlUp).Row
With ActiveSheet.Cells(1, c).Resize(Lastrow)
.AutoFilter 1, s
counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
If counter > 1 Then
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Archived").Rows(Lastrowa)
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

End If
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub

jolivanes
01-07-2020, 11:48 AM
How many rows are you working with in the "Forward Look Planner" sheet?
Does "meetings in the past" mean yesterday and before that?




Sub Maybe()


Dim c As Range, lc As Long


Dim sh1 As Worksheet, sh2 As Worksheet


Set sh1 = Worksheets("Forward Look Planner")


Set sh2 = Worksheets("Archived")


lc = sh1.Cells.Find("*", , , , xlByColumns, xlPrevious).Column


For Each c In sh1.Range("C2:C" & sh1.Cells(Rows.Count, 3).End(xlUp).Row)


If c.Value < Now() - 1 Then c.Offset(, -2).Resize(, lc).Copy sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1)


Next c


End Sub

SamT
01-07-2020, 12:21 PM
It's hard to tell since you gave no clues as to what was wrong or what it did, but, the only thing I can see wrong is that you did not increment Lastrowa.

This is my version of code to do what you say you want.
Option Explicit

Private Sub ArchiveOldMeetings()
Dim NRarch As Long 'Next Row
Dim LRplan As Long 'Last Row
' "C" is Date Column of Planner
Dim i As Long
Application.ScreenUpdating = False

NRarch = Sheets("Archived").Cells(Rows.Count, "A").End(xlUp).Row + 1
With Sheets("Forward Look Planner")
LRplan = .Cells(Rows.Count, "C").End(xlUp).Row
For i = LRplan To 4 Step -1
If Cells(LRplan, "C") < Date Then
.Rows(LRplan).Copy Sheets("Archived").Cells(NRarch, "A")
NRarch = NRarch + 1
.Rows(LRplan).Delete
End If
Next
End With

Application.ScreenUpdating = True
End Sub

mykal66
01-08-2020, 03:05 AM
25767Hi both and thank you very much for your replies. I have tried both and neither are working but that is probably due to me not describing my needs properly. I've attached a copy of the work book as it stands (still in progress) so you can see what i am trying to do. Literally if any date in Column C (Forward Look Planner) then move the row to the Archive TAB.

Thanks you both again for trying to help and apologies if it was my description

SamT
01-08-2020, 10:37 AM
LOOK OUT ! It's a brain fart!!:p:p:p

Replaced LRplan with i in three places


Private Sub Workbook_Open()
Dim NRarch As Long 'Next Row
Dim LRplan As Long 'Last Row
' "C" is Date Column of Planner
Dim i As Long
Application.ScreenUpdating = False

NRarch = Sheets("Archived").Cells(Rows.Count, "A").End(xlUp).Row + 1
With Sheets("Forward Look Planner")
LRplan = .Cells(Rows.Count, "C").End(xlUp).Row
For i = LRplan To 4 Step -1
If Cells(i, "C") < Date Then
.Rows(i).Copy Sheets("Archived").Cells(NRarch, "A")
NRarch = NRarch + 1
.Rows(i).Delete
End If
Next
End With

Application.ScreenUpdating = True


End Sub