Create pdf from excel with specific range and today's date data

He there,

Can somebady help me to change this vba or create new one. I want to create daily report with specific range and select data from colummn based on todays date.
I attached image of my schedule.
This is my vba to create monthly report.

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set year = ActiveSheet.Range("Q3")
Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
 
If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "Select folder to save PDF file." & vbCrLf & vbCrLf & "OK.", vbCritical, "Select location"
   Exit Sub
End If
xFolder = xFolder + "" + "Schedule " + xSht.Name + " " & Year & ".pdf"
 
'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " Exist." & vbCrLf & vbCrLf & "Do you want to save with this number?", _
                      vbYesNo + vbQuestion, "File with this name exist")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "File not saved." _
                    & vbCrLf & vbCrLf & "Ok.", vbCritical, "Exit"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Cant delete file. Check if file with same name is open." _
                    & vbCrLf & vbCrLf & "OK.", vbCritical, "Can't delete this file."
        Exit Sub
    End If
End If
 
Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
     
    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .Cc = ""
        .Subject = "Schedule " + xSht.Name + " " & Year & ", Data: " & Format(Date, "dd/mm/yyyy")
        .Attachments.Add xFolder
        .HTMLbody = "Test, " & "<br>" & " " & "<br>" & " Find atached " & xSht.Name & " " & Viti & "." & "<br>" & "<br>" & "BS,"
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "Empty Worksheet."
  Exit Sub
End If

Administrator's note: Please take the time to review our rules. There aren't many, and they are all important. Our guidelines recommend code tags. I have added them for you this time because you are a new member. --6StringJazzer