Retreat event On Format of report

[tempclerk]

The following code marks claim numbers in a report if they are duplicates of the previous claim number printed or if there is a gap in sequence between the current and previous claim numbers. Michael Red got me to the point that this works, except that when the list goes on to a new column or page, the Retreat event causes the code to run again, which means the first record of every new column is marked as a duplicate.

I had intended to learn some VBA skills and figure out how to fix this myself, but illness has kept me from studying. Now I find that this job is ending Friday, and I would like to have the report running smoothly before I go. Can anyone help? Thanks.


Option Compare Database
Option Explicit
Private Type CodeStatusType
Branch As String
CodeRt As String
End Type
Dim CodeStatus As CodeStatusType

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)

Dim StatusFlag As String
Dim blnNoCalc As Boolean

StatusFlag = ""

'Check for First Pass
If (CodeStatus.Branch = "" And CodeStatus.CodeRt = "&quot Then
'Initalization
With CodeStatus
.Branch = [Branch]
.CodeRt = [CodeRt]
End With
blnNoCalc = True
End If

'Not First Pass, Check for Branch Change
If (CodeStatus.Branch <> [Branch]) Then
'OOps - Change of Branch, So Dup and Seq == False
With CodeStatus
.Branch = [Branch]
.CodeRt = [CodeRt]
End With
blnNoCalc = True
End If

If (Not blnNoCalc) Then
'Check For DUPLICATE
If (CodeStatus.CodeRt = [CodeRt]) Then
StatusFlag = &quot;+&quot;
blnNoCalc = True
End If
End If

If (Not blnNoCalc) Then
If (CLng(CodeStatus.CodeRt) + 1 <> [CodeRt]) Then
StatusFlag = &quot;*&quot;
End If
End If

Me.txtStatus = StatusFlag

With CodeStatus
.Branch = [Branch]
.CodeRt = [CodeRt]
End With

End Sub



Let me know if further detail is needed.

 

[tempclerk]

In attempt to undo the calculations performed in the first pass of the format event, I added the following sub:

Private Sub Detail_Retreat()
'back up before second formatting
If StatusFlag = &quot;+&quot; Then
'If it's a duplicate, previous was the same
CodeStatus.CodeRt = CodeStatus.CodeRt
End If
If StatusFlag = &quot;&quot; Then
'If it's not a dup and not after a gap, previous was one less
CodeStatus.CodeRt = CodeStatus.CodeRt - 1
End If
If StatusFlag = &quot;*&quot; Then
'If it's after a gap, previous was at least two less
CodeStatus.CodeRt = CodeStatus.CodeRt - 2
End If
End Sub


This doesn't work. Is it because StatusFlag doesn't exist outside of the Private Sub Detail_Format? If so, how can I fix that? Any other ideas?

 

[tempclerk]

Apparently, the Retreat Sub wasn't running, so I moved the code up into the Format sub. This works now, so I'm posting in case it helps anyone else out.

Option Compare Database
Option Explicit
Private Type CodeStatusType
Branch As String
CodeRt As String
End Type
Dim CodeStatus As CodeStatusType
Dim StatusFlag As String


Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)

Dim blnNoCalc As Boolean

If (FormatCount) > 1 Then
'back up before second formatting
If StatusFlag = &quot;+&quot; Then
'If it's a duplicate, previous was the same
CodeStatus.CodeRt = CodeStatus.CodeRt
End If
If StatusFlag = &quot;&quot; Then
'If it's not a dup and not after a gap, previous was one less
CodeStatus.CodeRt = CodeStatus.CodeRt - 1
End If
If StatusFlag = &quot;*&quot; Then
'If it's after a gap, previous was at least two less
CodeStatus.CodeRt = CodeStatus.CodeRt - 2
End If
End If

StatusFlag = &quot;&quot;

'Check for First Pass
If (CodeStatus.Branch = &quot;&quot; And CodeStatus.CodeRt = &quot;&quot Then
'Initalization
With CodeStatus
.Branch = [Branch]
.CodeRt = [CodeRt]
End With
blnNoCalc = True
End If

'Not First Pass, Check for Branch Change
If (CodeStatus.Branch <> [Branch]) Then
'OOps - Change of Branch, So Dup and Seq == False
With CodeStatus
.Branch = [Branch]
.CodeRt = [CodeRt]
End With
blnNoCalc = True
End If


If (Not blnNoCalc) Then
'Check For DUPLICATE
If (CodeStatus.CodeRt = [CodeRt]) Then
StatusFlag = &quot;+&quot;
blnNoCalc = True
End If
End If

If (Not blnNoCalc) Then
If (CLng(CodeStatus.CodeRt) + 1 <> [CodeRt]) Then
StatusFlag = &quot;*&quot;
End If
End If

Me.txtStatus = StatusFlag

With CodeStatus
.Branch = [Branch]
.CodeRt = [CodeRt]
End With

End Sub