How to make buttons run code on correct row after sorting the rows? - vba

Question

I have a spreadsheet where the rows are individual projects and the columns are the information about of that project.
The columns I am dealing with are for a technician to make a service call so I have: Tech Name, Site Contact, Date, Time and duration.
In the next column I have a button that once clicked, will run my VBA code to generate a meeting request that is sent to that technician which also placed the event on my outlook calendar. This code has been proven and is fine.
I generated buttons for about 300 rows. Upon a click, the code SHOULD check the button's location with the Application.Caller and get row and column numbers which I use to pull info for the meeting request.
Initially the button press works.
The issue is that I have the sheet set to auto sort with AutoFilter.ApplyFilter. So when I enter a job a row 92 with associated button 92 and the row auto sorts to say 30, the button 30 now tries to schedule 31 and button 92 is now scheduling row 30 (not sure where the button that schedules row 30 goes).
When clicked, the button should be reporting the cell directly under it.
Code to create buttons:
Option Explicit
Public Sub CreateButtons()
Application.ScreenUpdating = False
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Projects")
Dim BTN As Button
Dim btn1 As Range
Dim btn2 As Range
Dim btn3 As Range
Dim i As Long
For i = 2 To 95
Set btn1 = ws.Cells(i, 22)
Set BTN = ws.Buttons.Add(btn1.Left, btn1.Top, btn1.Width, btn1.Height)
With BTN
.Caption = "Schedule" & i
.OnAction = "TASKSCHEDULER"
End With
Set btn2 = ws.Cells(i, 31)
Set BTN = ws.Buttons.Add(btn2.Left, btn2.Top, btn2.Width, btn2.Height)
With BTN
.Caption = "Schedule"
.OnAction = "TASKSCHEDULER"
End With
Set btn3 = ws.Cells(i, 40)
Set BTN = ws.Buttons.Add(btn3.Left, btn3.Top, btn3.Width, btn3.Height)
With BTN
.Caption = "Schedule"
.OnAction = "TASKSCHEDULER"
End With
Next i
Application.ScreenUpdating = True
End Sub
Code for Button Click:
Option Explicit
Public Sub TASKSCHEDULER()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Projects")
Dim b As Object
Dim r As Long
Dim c As Long
Set b = ws.Buttons(Application.Caller)
With b.TopLeftCell
r = .Row
c = .Column
End With
Dim TECH As String
Dim sitecon As String
Dim connum As String
Dim schdate As String
Dim schtime As String
Dim schdur As String
If IsEmpty(ws.Cells(r, c - 8)) Then 'VerIfy data has been entered into all fields needed - works
TECH = "Technician" & vbCrLf
Else
TECH = vbNullString
End If
If IsEmpty(ws.Cells(r, c - 5)) Then
sitecon = "Site Contact" & vbCrLf
Else
sitecon = vbNullString
End If
If IsEmpty(ws.Cells(r, c - 4)) Then
connum = "Site Contact Phone #" & vbCrLf
Else
connum = vbNullString
End If
If IsEmpty(ws.Cells(r, c - 3)) Then
schdate = "Date" & vbCrLf
Else
schdate = vbNullString
End If
If IsEmpty(ws.Cells(r, c - 2)) Then
schtime = "Start Time" & vbCrLf
Else
schtime = vbNullString
End If
If IsEmpty(ws.Cells(r, c - 1)) Then
schdur = "Duration" & vbCrLf
Else
schdur = vbNullString
End If 'End field verify
If IsEmpty(ws.Cells(r, c - 7)) Or IsEmpty(ws.Cells(r, c - 5)) Or IsEmpty(ws.Cells(r, c - 4)) Or IsEmpty(ws.Cells(r, c - 3)) Or IsEmpty(ws.Cells(r, c - 2)) Or IsEmpty(ws.Cells(r, c - 1)) Then 'Call out missing fields If present
MsgBox "Missing Fields: " & vbCrLf & vbCrLf & TECH & sitecon & connum & schdate & schtime & schdur
Else
SCHMTG 'Schedule Meeting
End If
'Else
'CNCLMTG 'Cancel Meeting
End Sub

Answer 1

Maybe try shrinking your button a bit so it fits more accurately within the underlying cell space:
Set BTN = ws.Buttons.Add(btn1.Left+2, btn1.Top+2, btn1.Width-4, btn1.Height-4)