Message Box Offset Error When Sorting

Hello. I'm new to subscribing to this forum but have searched for (and found) assistance many times in the past prior to registering. I am an intermediate user of Excel but a vba novice.

I've attached a workbook with two filtered worksheets (MCT and PCT) that are set up as tables with vba. I don't know if this matters but I have to keep them as filtered tables.

When the workbook opens:
1-Sorts the MCT worksheet by red font in current status (column k) then by earliest end date (column G) then by alpha vendor (column C) and then changes column J to red font and then goes to cell E2
2-Sorts the PCT worksheet by red font in current status (column k) then by earliest end date (column G) then by alpha vendor (column B--notice different column from MCT) and then changes column J to red font and then goes to cell D2 (notice different cell from MCT)

I also have a sort button at the top of each worksheet that performs the same sorting when pressed.

I also have included in the vba and conditional formatting to highlight the active row.

What I need:
When select any cell in column K where the end date (column G) on the same corresponding row is in the past or is set to expire within the next 10 days from today to show a message box for that same row in column K. So in cell MCT!K2, I should get see the message box because the end date is in the past.

I thought I had this working but when I try to sort either by choosing the filter drop down arrow then "Sort A-Z", pressing the sort button in either worksheet, or by opening the workbook, I get the error message in the vba code for either worksheet: "Run-time error '1004': Application-defined or object-defined error".

I know I don't have any declarations but I don't know I'm doing. As I mentioned previously, I'm a novice with vba.

I've attached the workbook and also below is the vba I have.

VBA in the Module (this is for the MCT worksheet which is the same is for the PCT worksheet but with a few differences):
Sub MSortEndDateVendor()
'
' MSortEndDateVendor Macro
'
Application.ScreenUpdating = False
ActiveWorkbook.Worksheets("MCT").ListObjects("Table1").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("MCT").ListObjects("Table1").Sort.SortFields.Add( _
Range("Table1[Current Status of Contract]"), xlSortOnFontColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 0, 0) 'red font
ActiveWorkbook.Worksheets("MCT").ListObjects("Table1").Sort.SortFields. _
Add2 Key:=Range("Table1[End]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal 'earliest end date
ActiveWorkbook.Worksheets("MCT").ListObjects("Table1").Sort.SortFields. _
Add2 Key:=Range("Table1[Vendor]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal 'alpha vendor
With ActiveWorkbook.Worksheets("MCT").ListObjects("Table1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Columns("J:J").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With

Cells.Select
Cells.EntireRow.AutoFit
Range("e2").Select

Columns("J:J").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With

Cells.Select
Cells.EntireRow.AutoFit
Range("d2").Select

Application.ScreenUpdating = True
End Sub

-----------------------------------------------------
VBA in the Excel Objects under This Workbook:
Private Sub Workbook_Open()

Call MSortEndDateVendor
Call PSortEndDateVendor


Worksheets("PCT").Activate
Columns("J:J").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With

Range("D2").Select

Worksheets("MCT").Activate
Columns("J:J").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With

Range("E2").Select

End Sub
--------------------------------------------------------
VBA in the Excel Objects MCT worksheet (the same would be in the PCT worksheet once I get it working correctly):
'this part is used for the highlighting row of selected cell
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Calculate


'this part is checking the expiratiion date
Dim rg As Range
Set rg = Worksheets("MCT").Range("K:K")

If Intersect(Target, Range("K:K")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub

'Explanation----if column G date < today+10 days [due within the next 10 days] then message box when select cell in column K for same row

If Target.Offset(0, -4).Value < Now() + 10 Then 'expiring within the next 10 days
MsgBox Prompt:="This MCT is PAST DUE or expiring soon!" & vbNewLine & vbNewLine & "Ensure all good with vendor", Title:="Reminder!!!!", Buttons:=vbCritical
End If

End Sub


I appreciate any assistance.

It seems to work for me now: I limited the rows to 10,000

Please Login or Register  to view this content.

I downloaded your workbook but I still get the error when opening it or when I try to sort. It errors on the line "if targer.offset......"

Try Running this code on your MCT sheet to reset the EnableEvents:

Please Login or Register  to view this content.

Also try rewriting the offending code to look like:

Please Login or Register  to view this content.

Here you go. I had to suppress the enableevents in the sort that affected column K that was kicking off the Msg Box