logic causing variable not to pass to function - excel

Question

I am having an issue getting a variable set to pass to a function properly. The frustrating part is that until yesterday this code has been working properly for a good 4 months of weekly use.
Below is the code, removing the dims and parts of the code that will not help resolve this issue.
Sub Combined_15_and_45()
'Dim Iteration Variables
'Dim tracking variables
'Dim range variables
'Dim Invoice Value Variables
'Dim Email body variables
Set wb = ThisWorkbook
Set WithTerms = Sheet4
Set APEmail = Sheet7
With wb
With WithTerms
lrow = .Cells(Rows.Count, 5).End(xlUp).Row
elrow = Sheet7.Cells(Rows.Count, 1).End(xlUp).Row
CalcDate = .Cells(1, 3).Value
i = 1
'loop through looking for times when cell above is different *Store i Instance
'loop through looking for times when cell below is different *Store i as EndInstance
'Specifically searching for changes in account number
For i = 4 To lrow
h = i - 1
j = i + 1
Set rng = .Cells(i, 5)
Set RngUp = .Cells(h, 5)
Set RngDwn = .Cells(j, 5)
'this is where vendor account changes.
If rng.Value <> RngUp.Value Then
instance = i
End If
'Check if invoice for the line is extreme past due *Store i as MaxOvrDue
If .Cells(i, 10).Value <= .Range("C1").Value - 45 Then
MaxOvrDue = i
End If
'check if invoice for line is +15 day overdue, less than 45 * Store i as MidOvrDur
If .Cells(i, 10).Value <= .Range("C1").Value - 15 Then
If .Cells(i, 10).Value >= .Range("C1").Value - 44 Then
If MidOvrdue = 0 Then
MidOvrdue = i
End If
End If
End If
'Check if Invoice for line is 15+ days overdue (Minimum) *Store i as Ovrdue
If .Cells(i, 10).Value < .Range("C1").Value Then
If .Cells(i, 10).Value <= .Range("C1").Value - 14 Then
OvrDue = i
End If
End If
'figure values for the totals of each section
If rng.Value <> RngDwn.Value Then
EndInstance = i
TotalOverdue = Application.WorksheetFunction.SumIfs(.Range("K:K"), .Range("E:E"), .Cells(instance, 5), .Range("J:J"), "<" & (.Range("c1") - 15))
XtrmOverdue = Application.WorksheetFunction.SumIfs(.Range("K:K"), .Range("E:E"), .Cells(instance, 5), .Range("J:J"), "<" & .Range("C1") - 44)
MidTotalOverdue = Application.WorksheetFunction.SumIfs(.Range("K:K"), .Range("E:E"), .Cells(instance, 5), .Range("J:J"), "<" & .Range("C1") - 15, .Range("J:J"), ">=" & .Range("C1") - 45)
If OvrDue = 0 And MaxOvrDue = 0 And MidOvrdue = 0 Then
Else:
'begin building Extremely Overdue Invoice Text
If MaxOvrDue <> 0 And MidOvrdue = 0 Then
**Set XtrmTblRng = .Range(.Cells(instance, 7), .Cells(MaxOvrDue, 11))**
End If
If OvrDue <> 0 And MidOvrdue <> 0 Then
If MaxOvrDue = 0 And OvrDue <= MidOvrdue Then
**Set MidTblRng = .Range(.Cells(MidOvrdue, 7), .Cells(OvrDue, 11))**
'Begin building ONLY overdue email text
Else:
'begin building segments to add to extreme overdue email
**Set XtrmComboTblRng = .Range(.Cells(instance, 7), .Cells(OvrDue, 11))**
End If
End If
If OvrDue <> 0 Then
'Generate the email
With OutMail
.To = eAddy
'Figure out which email to send
If MaxOvrDue <> 0 And MidTotalOverdue <> 0 Then
.HTMLbody = StrBodyXtrm & RangetoHTML(XtrmComboTblRng, CalcDate) & ComboStrBody2 & StrBody4
Else
If MaxOvrDue <> 0 And MidOvrdue = 0 Then
.HTMLbody = StrBodyXtrm & RangetoHTML(XtrmTblRng, CalcDate) & StrBody2 & StrBody4
Else:
.HTMLbody = StrBodyOverdue & RangetoHTML(MidTblRng, CalcDate) & StrBody3
End If
End If
.display
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End If
End If
'clear variables when changing vendor IDs
End If
Set rng = .Cells(j, 5)
Next i
End With
End With
End Sub
Function RangetoHTML(TblRng, CalcDate)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
Dim tRow As Long
Dim i As Long
Dim CalcDate2 As Double
Dim TempDate As Double
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to paste the data in. This is where I am getting errors all the sudden
**TblRng.Copy**
'manipulate the data from table to fit needs and past into email.
End Function
Essentially this is trying to sort through stack of invoices and determine which email format to use.
Invoices aged 45+
Invoices aged 15-45+
Invoices aged 15-44
I am running into an issue with the email determining a different email format should be used than the TblRng variable that has been built to pass to the function. I just cant seem to find my logic error.
I have been banging my head against a wall for a few days now trying to fix this with no luck. Any help you can give will make you a hero in my eyes!
Thank you

Answer 1

The problem with your logic is with this line
If maxOvrDue = 0 And OvrDue <= midOvrDue Then
If there are no >45 lines (maxOvrDue = 0) then at the first occurance of a >15 line
midOvrDue and OvrDue will be the same. On subsequent >15 lines OvrDue will
be greater than midOvrDue. So the above will be true for 1 and false for 2 or more
lines in the 44-15 range. With 2 or more the default Else option will then Set XtrmComboTblRng not MidTblRng.
Later because maxOvrDue = 0 the email .HTMLbody uses RangetoHTML(MidTblRng, CalcDate).
The remedy would be to just use If maxOvrDue = 0 Then.
You could set an email type within the same logic as used to set the ranges so the mismatch can't occur. Here is an example of how to do that
Option Explicit
Sub Combined_15_and_45()
Dim WithTerms As Worksheet, APEMail As Worksheet
Dim rng As Range, tblRng As Range
Dim lrow As Long, elrow As Long, i As Long
Dim instance As Long, maxOvrDue As Long, midOvrDue As Long
Dim CalcDate As Date, DaysLate As Integer, EmailFormat As Integer
Dim has45 As Boolean, has15 As Boolean
Dim acc As String
Dim TotalOverdue As Currency
Dim XtrmOverdue As Currency, MidTotalOverdue As Currency
Set APEMail = Sheet7
elrow = APEMail.Cells(Rows.Count, 1).End(xlUp).row
' for debugging
Dim fso, ts
Set fso = CreateObject("Scripting.FileSystemObject")
' scan down sheet
Set WithTerms = Sheet4
With WithTerms
lrow = .Cells(Rows.Count, "E").End(xlUp).row 'Row E
CalcDate = .Range("C1").Value
For i = 4 To lrow
'this is where vendor account changes.
Set rng = .Cells(i, 5) ' E Account
If rng.Value <> rng.Offset(-1).Value Then
acc = rng
instance = i
maxOvrDue = 0
midOvrDue = 0
XtrmOverdue = 0
MidTotalOverdue = 0
End If
' check days overdue
DaysLate = DateDiff("d", .Cells(i, "J").Value, CalcDate)
If DaysLate >= 45 Then
maxOvrDue = i
XtrmOverdue = XtrmOverdue + .Cells(i, "K")
ElseIf DaysLate >= 15 Then
midOvrDue = i
MidTotalOverdue = MidTotalOverdue + .Cells(i, "K")
End If
' is this last for account
If rng <> rng.Offset(1) Then
TotalOverdue = XtrmOverdue + MidTotalOverdue
Debug.Print vbCr & acc & " Total", XtrmOverdue, MidTotalOverdue, TotalOverdue
has45 = maxOvrDue > 0
has15 = midOvrDue > 0
If has45 Or has15 Then
If has45 And has15 Then
EmailFormat = 1
Set tblRng = .Range(.Cells(instance, 7), .Cells(midOvrDue, 11))
Debug.Print "+45 and +15", tblRng.Address
' begin building segments to add to extreme overdue email
ElseIf has45 Then
EmailFormat = 2
Set tblRng = .Range(.Cells(instance, 7), .Cells(maxOvrDue, 11))
Debug.Print "+45 only", tblRng.Address
' begin building Extremely Overdue Invoice Text
ElseIf has15 Then
EmailFormat = 3
Set tblRng = .Range(.Cells(instance, 7), .Cells(midOvrDue, 11))
Debug.Print "+15 only", tblRng.Address
' begin building ONLY overdue email text
End If
' select email format
Dim body As String
Select Case EmailFormat
Case 1
body = "strBodyXtrm" & RangetoHTML(tblRng, CalcDate) & "ComboStrBody2 & strBody4"
Case 2
body = "strBodyXtrm" & RangetoHTML(tblRng, CalcDate) & "strBody2 & strBody4"
Case 3
body = "strBodyOverdue" & RangetoHTML(tblRng, CalcDate) & "strBody3"
End Select
' create html file for checking
Set ts = fso.createTextFile(ThisWorkbook.Path & "\" & acc & ".html", 1)
ts.write body
ts.Close
'Generate the email
'With outmail
'.To = eAddy
'.HTMLbody = body
'.display
'End with
End If
End If
Next i
End With
MsgBox "Done"
End Sub
Function RangetoHTML(tblRng, CalcDate) As String
Dim s, rw As Range, cell As Range, pre As String
pre = "<pre>TblRng=" & tblRng.Address(External:=1) & "</pre>"
s = "<tr align=""center"" bgcolor=""#ddddff"">" & _
"<th>Col G</th><th>Col H</th><th>Col I</th>" & _
"<th>Col J</th><th>Col K</th></tr>" & vbCrLf
For Each rw In tblRng.Rows
s = s & "<tr>"
For Each cell In rw.Cells
s = s & "<td>" & cell & "</td>"
Next
s = s & "</tr>" & vbCrLf
Next
RangetoHTML = pre & "<table cellspacing=""0"" cellpadding=""3"" border=""1"">" & _
s & "</table>" & vbCrLf
End Function