how to find next Available date if it didn't find comended date using VBA

Question

I need help here. I have Sheet 1 and Sheet2. and in Sheet1/2 I have dates in the column B and both sheet dates are not same but when I commend for Select date for print I want VBA to select nearest date if it coudn't find my date. For example:- if I ask VBA to print from date 12-Aug-17 I can be selected in sheet1 but in Sheet 2 there is no 12th Aug so it has to select 13th or 11th and print. In my coding, if it’s in same date it will print both the sheet. But if it fails then it will show the error.

Code

Sub CreatePDF()
Dim Sh As Worksheet
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
Dim i, j2, j3, sh2EndCell, sh3EndCell As Integer
Dim closest As Date
Dim W1Enddate As Date

W1Enddate = Application.InputBox("Enter the End Date")
sh2EndCell = sh2.Range("b" & Rows.Count).End(xlUp).Row
sh3EndCell = sh3.Range("b" & Rows.Count).End(xlUp).Row
For i = 2 To sh2EndCell
    If sh2.Range("b" & i).Value = W1Enddate Then
        j2 = i
        Exit For
    End If
Next i

For i = 2 To sh3EndCell
    If sh3.Range("b" & i).Value = W1Enddate Then
        j3 = i


        Exit For
    End If
Next i

sh2.Range("A1", "K" & j2).PrintPreview
sh3.Range("A1", "K" & j3).PrintPreview

Application.ScreenUpdating = False

sh2.PageSetup.PrintArea = ("A1:K" & j2)
sh3.PageSetup.PrintArea = ("A1:K" & j3)
Sheets(Array("sheet2", "sheet3")).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="", _
OpenAfterPublish:=True
Application.ScreenUpdating = True

End Sub

Please see Above my code.

What do you want the code to do it there are two dates, both the same distance away. Eg you choose 11th but, though 11th is not in the table 10th and 12th are. Which do you want? — Rob Anthony

Tony M Tony M · Accepted Answer · 2017-07-29T08:12:37

I think there are 2 problems with your code:

j2 & j3 are Variants (not integers, as I think you want)
your code doesn't do anything to find "the closest" date -- you have a closest Date variable that is not used anywhere

Because of (1), if an exact match for the date is not found, j2 or j3 will not be defined so a line like sh3.Range("A1", "K" & j3).PrintPreview will crash. Note how in my code j2 & j3 are made integers. By contrast, in your code the type of i, j2, j3, sh2EndCell are NOT specified and are therefore Variant by default).

To solve (2), the code below finds the closest date in each case. min starts out as a large number, and is replaced by diff, each time a smaller difference between dates is found. Notice that there is no more Exit For in my code since it loops through all dates to be sure it has found the closest date. Hope that helps.

Option Explicit
Sub CreatePDF()
Dim Sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
Dim i As Integer, j2 As Integer, j3 As Integer, sh2EndCell As Integer, sh3EndCell As Integer
Dim closest As Date, diff As Long, min As Long
Dim W1Enddate As Date

W1Enddate = Application.InputBox("Enter the End Date")
sh2EndCell = sh2.Range("b" & Rows.Count).End(xlUp).Row
sh3EndCell = sh3.Range("b" & Rows.Count).End(xlUp).Row
min = 100000#
For i = 2 To sh2EndCell
  diff = Abs(W1Enddate - sh2.Range("b" & i).Value)
  If diff < min Then
    min = diff
    j2 = i
  End If
Next i
min = 100000#
For i = 2 To sh3EndCell
  diff = Abs(W1Enddate - sh3.Range("b" & i).Value)
  If diff < min Then
    min = diff
    j3 = i
  End If
Next i

sh2.Range("A1", "K" & j2).PrintPreview
sh3.Range("A1", "K" & j3).PrintPreview

Application.ScreenUpdating = False

sh2.PageSetup.PrintArea = ("A1:K" & j2)
sh3.PageSetup.PrintArea = ("A1:K" & j3)
Sheets(Array("sheet2", "sheet3")).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="", _
OpenAfterPublish:=True
Application.ScreenUpdating = True

End Sub

how to find next Available date if it didn't find comended date using VBA

1 Answers