VBA Help Please

[victorski]

Hello brains trust,

I'm hoping someone can help me.

I have a workbook that I use to manage a project - I have 3 sheets, 'Overdue' (Sheet3), 'Priority Master List' (Sheet4) and 'Completed' (Sheet10)

The priority master list has activities listed in it - I created a macro that copies an entire row to the 'Overdue' when 'Days Left' is less than or equal to '5'.

Sub MoveData()
Sheet4.Range("A1:G1").AutoFilter
Sheet4.[G1:G150].AutoFilter Field:=7, Criteria1:="<=5"
Sheet4.[A1:G150].Copy Sheet3.[A1]
Sheet4.[A1].AutoFilter
End Sub

This seems to work good for my purposes.

I would also like the macro to move rows to the 'Completed' sheet and then delete it from the 'Master Priority List' when a date inputted into the 'END' field.

Could anyone please help me with this?

I also have a manager who reviews my workbook and doesn't know how to run the macro - is it possible to program it run automatically rather than manually running it?

Any help would be greatly appreciated.

Victor

Priority Master List Mini-sheet:

IDLMP Works Schedule EXTRA TEST.xlsm
	A	B	C	D	E	F	G	H	I
1	Priority	Task	Comments	ASSIGNED TO	PROGRESS	DUE	DAYS LEFT	START	END
2
3	1				10%	31/12/2024	33
4	1.1				0%	15/12/2024	17
5	1				10%	31/12/2024	33
6	1.2				0%	15/12/2024	17
7	1.2				0%	20/01/2025	53
8	1.2				0%	20/01/2025	53
9	1.2				0%	15/12/2024	17
10	1.3				0%	20/12/2024	22
11	1.4				0%	31/12/2025	398
12	1.4				0%	15/12/2024	17
13	1.4				0%	20/01/2025	53
14	1.4				0%	20/01/2025	53
15	1.4				0%	15/12/2024	17
16	1.4				0%	1/03/2025	93
17	1.5				5%	31/12/2024	33
18	1.5				0%	15/12/2024	17
19	1.5				0%	20/01/2025	53
20	1.5				0%	20/01/2025	53
21	1.5				95%	15/12/2024	17
22	1.5				0%	15/11/2024	-13
23	1.5				0%	15/11/2024	-13
24	1.5				20%	6/11/2024	-22
25	1.5				10%	30/10/2024	-29
26	1.5				0%	23/11/2024	-5
27
28	2.1				0%	31/12/2024	33
29	2.1				0%	7/11/2024	-21
30	2.1				0%	20/01/2025	53
31	2.2				0%	31/12/2027	1128
32	2.3				0%	31/12/2027	1128
33	2.4				0%	31/12/2024	33
34	2.5				0%	31/12/2027	1128
35
36	3.1				0%	12/03/2025	104
37	3.2				0%	11/02/2025	75
38	3.3				0%	3/03/2025	95
39
40	4.1				0%	3/12/2024	5
41	4.1				0%	8/10/2024	-51
42	4.1				0%	8/11/2024	-20
43	4.2				0%
44	4.3				0%
45	4.4				0%	3/12/2024	5
46	4.4				0%	8/10/2024	-51
47	4.4				0%	8/11/2024	-20
48	4.5				0%	14/01/2025	47
49	4.6				0%
50	5
51	5.1				100%			24/07/2024	24/07/2024
52	5.2				0%	3/03/2025	95
53	5.2				95%	15/10/2024	-44	15/08/2024	24/10/2024
54	5.2				0%
55	5.2				0%	31/10/2024	-28
56	5.2				0%	15/12/2024	17
57	5.2				90%	31/10/2024	-28
58	5.2				0%	5/12/2024	7
59	5.2				0%	5/12/2024	7
60	5.2				0%	10/12/2024	12
61	5.2				0%	20/01/2025	53
62	5.3				0%	3/03/2025	95
63	6
64	6.1				90%	4/12/2024	6
Priority Master List

Cell Formulas
Range	Formula
G3:G26,G64,G55:G62,G52:G53,G45:G48,G40:G42,G36:G38,G28:G34	G3	=F3-TODAY()

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
I5	Expression	=AND($G5<>"",$G5<=5)	text	NO
I3	Expression	=AND($G3<>"",$G3<=5)	text	NO
I10	Expression	=AND($G10<>"",$G10<=5)	text	NO
I4	Expression	=AND($G4<>"",$G4<=5)	text	NO
I6:I9	Expression	=AND($G6<>"",$G6<=5)	text	NO
E64	Other Type	DataBar		NO
E64	Expression	=AND($G64<>"",$G64<=5)	text	NO
E28	Other Type	DataBar		NO
E31:E34	Other Type	DataBar		NO
E55:E56	Other Type	DataBar		NO
E57:E62,E51:E54	Other Type	DataBar		NO
E29:E30	Other Type	DataBar		NO
D67:I154,D14:I63,D3:H13,I11:I13	Expression	=AND($G3<>"",$G3<=5)	text	NO
E18:E20	Other Type	DataBar		NO
E21:E26,D63,E35:E49,E3:E17,E54	Other Type	DataBar		NO

Overdue Mini-sheet:

IDLMP Works Schedule EXTRA TEST.xlsm
	A	B	C	D	E	F	G
1	Priority	Task	Comments	ASSIGNED TO	PROGRESS	DUE	DAYS LEFT
2	1.5				0%	15/11/2024	-13
3	1.5				0%	15/11/2024	-13
4	1.5				20%	6/11/2024	-22
5	1.5				10%	30/10/2024	-29
6	1.5				0%	23/11/2024	-5
7	2.1				0%	7/11/2024	-21
8	4.1				0%	3/12/2024	5
9	4.1				0%	8/10/2024	-51
10	4.1				0%	8/11/2024	-20
11	4.4				0%	3/12/2024	5
12	4.4				0%	8/10/2024	-51
13	4.4				0%	8/11/2024	-20
14	5				95%	15/10/2024	-44
15	5				0%	31/10/2024	-28
16	5				90%	31/10/2024	-28
Overdue

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E15	Other Type	DataBar		NO
E14,E16	Other Type	DataBar		NO
E7	Other Type	DataBar		NO
D19:G104,D2:G16	Expression	=AND($G2<>"",$G2<=5)	text	NO
E8:E13,E2:E6	Other Type	DataBar		NO

Completed Mini-sheet:

IDLMP Works Schedule EXTRA TEST.xlsm
	A	B	C	D	E	F	G	H	I
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Completed

 

[victorski]

Hello all,

I have 3 worksheets, 'Master List' (Sheet4), 'Completed' (Sheet10) and 'Overdue' (Sheet3).

I work out of the Master List which has a list of tasks.

I have tried putting together two macros, but I desperately need some help.

I want Macro 1 to run when the workbook is opened or when the date in 'G' is changed - I want the macro to determine if the value in 'Days Left' (J) is <= 5, and then copy the entire row to Overdue 'Sheet3'

This is the macro I wrote:

Private Sub Workbook_Open()

Sheet4.Range("A1:J1").AutoFilter
Sheet4.[G1:G150].AutoFilter Field:=7, Criteria1:="<=5"
Sheet4.[A1:J150].Copy Sheet3.[A1]
Sheet4.[A1].AutoFilter

End Sub

This macro works to move them from Sheet4 to Sheet3, but is only triggered when I open the notebook not when a value in 'G' is changed.

I want Macro 2 to run anytime 'YES' is entered into Completed 'J' - I want it to move the entire row to Completed 'Sheet10', and delete the row from Master List (Sheet4) and Overdue (Sheet3).

This is the Macro I wrote:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("J:J")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Target.EntireRow.Copy Sheets("Completed").Cells(Sheets("Completed").Rows.Count, "A").End(xlUp).Offset(1)
Target.EntireRow.Delete
Application.EnableEvents = True

End Sub

I couldn't figure out how to get the macro to activate when I typed YES so now it activates as soon as anything is entered into the field - also I can't seem to insert new rows into the Sheet4 as it just moves them straight to Sheet10.

Please can anybody help?

 

[Skyybot]

You have to add another If statement.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column = Range("J:J").Column Then
        If .Value = "Yes" Then
            Application.EnableEvents = False
            Target.EntireRow.Copy Sheets("Completed").Cells(Sheets("Completed").Rows.Count, "A").End(xlUp).Offset(1)
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    End If
End With
        
End Sub

 

[Skyybot]

Also, if you want to Paste to multiple locations then (as an example):

Selection.EntireRow.Copy
Sheets("Sheet1").Cells(1,1).PasteSpecial
Sheets("Sheet2").Cells(1,1).PasteSpecial
Application.CutCopyMode = False

 

[Skyybot]

Moreover, you can remove the original data by using

Selection.EntireRow.Cut Sheets("Sheet1").Cells(1,1)

But really you don't have to use Copy or Cut at all. You can just

Sheets("Sheet1").Rows(Selection.Row).Value = Sheets("Sheet2").Rows(1).Value

 

[victorski]

Thank you so much - that has fixed inserting new rows!! Yay

I'm sorry, I'm struggling to figure out where to put those additional lines of code?

I put the first macro you gave into the code for "Master Priority List"

Now If I put the following macro into a module and run it, the row disappears as it no long exists on the Priority Master List.

Sub MoveData()
Sheet4.Range("A1:J1").AutoFilter
Sheet4.[G1:G150].AutoFilter Field:=7, Criteria1:="<=5"
Sheet4.[A1:J150].Copy Sheet3.[A1]
Sheet4.[A1].AutoFilter
End Sub


Would you be able to help with the Macro so that it automatically updates when the workbook is opened and if the date in "G" is changed and also delete the entry once it is removed from 'Priority Master List' sheet?

Thank you again for your time, I really appreciate it.

 

[Skyybot]

I think I understand what you want. Try this on a copy of your Workbook.

Insert a new Module and re-name it SortWB. Paste the following code into it.

Option Explicit

Sub DaysLeftChange()

Dim wb As Workbook, msht As Worksheet, osht As Worksheet, rng As Range, lr As Long, i As Long

Set wb = ThisWorkbook
Set msht = wb.Sheets("Priority Master List")
Set osht = wb.Sheets("Overdue")
osht.Cells.ClearContents
Set rng = Range(msht.Cells(1, 1), msht.Cells(lRow(msht, msht.Rows.End(xlDown).Row), msht.Columns.End(xlToRight).Column))
rng.AutoFilter Range("C:C").Column, "Troy"
For i = 1 To rng.Rows.Count
    If rng.Rows(i).Hidden = False Then
        Range(osht.Cells(lRow(osht, osht.Rows.End(xlDown).Row) + 1, 1), osht.Cells(lRow(osht, osht.Rows.End(xlDown).Row) + 1, _
            rng.Columns.Count)).Value = rng.Rows(i).Value
    End If
Next i
rng.AutoFilter

End Sub
Private Function lRow(ByRef sht As Worksheet, ByVal last_row As Long) As Long

Static cnt As Integer
If last_row = sht.Rows.Count And IsEmpty(sht.Cells(1, 1)) Then lRow = 0: Exit Function
If last_row = sht.Rows.Count And Not IsEmpty(sht.Cells(1, 1)) Then lRow = 1: Exit Function
lRow = sht.Rows.End(xlDown).Row

End Function

The following code will be pasted into the Priority Master List Sheet code module

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
    If .CountLarge > 1 Then Exit Sub
        If .Column = Range("G:G").Column Then
           SortWB.DaysLeftChange
        End If
    End If
End With
With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column = Range("J:J").Column Then
        If .Value = "Yes" Then
            Application.EnableEvents = False
            Target.EntireRow.Cut Sheets("Completed").Cells(Sheets("Completed").Rows.Count, "A").End(xlUp).Offset(1)
            Target.EntireRow.Delete
            Application.CutCopyMode = False
            Application.EnableEvents = True
        End If
    End If
End With
        
End Sub

The following code will be pasted into ThisWorkbook code module

Private Sub Workbook_Open()
SortWB.DaysLeftChange
End Sub

 

[victorski]

Thank you Skybott, I really appreciate your help I have pasted in the codes where you have suggested.

When the Macro runs it shows the following errors, then it activates the filter on column C.

Any ideas what I might have done wrong?

 

[victorski]

Hi Skybott, apologies to write again and to take so much of your time.

I tried your instructions again and started getting 'Compile error: End If without block if' on Private Sub Worksheet_Change so I removed a duplicate End If statement and it seems to be okay now.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
    If .CountLarge > 1 Then Exit Sub
        If .Column = Range("G:G").Column Then
           SortWB.DaysLeftChange
        End If
End With
With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column = Range("J:J").Column Then
        If .Value = "Yes" Then
            Application.EnableEvents = False
            Target.EntireRow.Cut Sheets("Completed").Cells(Sheets("Completed").Rows.Count, "A").End(xlUp).Offset(1)
            Target.EntireRow.Delete
            Application.CutCopyMode = False
            Application.EnableEvents = True
        End If
    End If
End With
        
End Sub

Now if I put yes in column J it moves it to 'Completed' which is perfect - but it leaves the now empty cells on 'Priority Master List' can these be removed automatically?

Also, if I put any figures less than or equal to 5 into column Days Left 'G' it doesn't move them to the 'Overdue' sheet, any ideas why this is?

If it helps the due 'F' column has a date, then the 'G' column (Days Left) has '=F1-TODAY()'

I'm not sure if it makes any difference but I have those columns headers replicated on all 3 sheets, so the actual data doesn't start till A2:J2

Thank you again for all your help - if I can do anything to assist please don't hesitate to ask.

 

[Fuji]

I want Macro 1 to run when the workbook is opened or when the date in 'G' is changed - I want the macro to determine if the value in 'Days Left' (J) is <= 5, and then copy the entire row to Overdue 'Sheet3'

1) To Sheet4 worksheet code module

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("g")) Is Nothing Then
        Range("A1:J1").AutoFilter
        [G1:G150].AutoFilter Field:=7, Criteria1:="<=5"
        [A1:J150].Copy Sheet3.[A1]
        [A1].AutoFilter
    ElseIf Not Intersect(Target, Columns("I")) Is Nothing Then
        Application.EnableEvents = False
        Target.EntireRow.Copy Sheets("Completed").Range("a" & Rows.Count).End(xlUp)(2)
        Target.EntireRow.Delete
        Application.EnableEvents = True
    End If
End Sub

2) To ThisWorkbook code module

Private Sub Workbook_Open()
    Run "Sheet4.worksheet_change", Sheet4.[g1]
End Sub