Here is the code that is calling the merge. I think it may be part of the problem.
Code:
Private Sub cb_preview_Click()
Dim ws_vh As Worksheet, ws_th As Worksheet, ws_lists As Worksheet
Dim path As String, dirname As String, dest1 As String
Dim riq As Double
Dim objWord As Object
Set ws_vh = Workbooks("sports15b.xlsm").Worksheets("VAR_HOLD")
Set ws_th = Workbooks("sports15b.xlsm").Worksheets("TEMP_HOLD")
Set objWord = CreateObject("Word.Application")
If Me.tb_of_rpt = 0 Then
MsgBox "No reports have been selected.", vbExclamation, "ERROR"
Exit Sub
End If
'populate print que
With ws_th
'Reg Diamonds
If Me.tglb_cue_diar.Value = True Then
last_cell
.Range("A" & lj) = "CUE-DR"
End If
If Me.tglb_hpe_diar.Value = True Then
last_cell
.Range("A" & lj) = "HPE-DR"
End If
If Me.tglb_rpe_diar.Value = True Then
last_cell
.Range("A" & lj) = "RPE-DR"
End If
If Me.tglb_wpe_diar.Value = True Then
last_cell
.Range("A" & lj) = "WPE-DR"
End If
If Me.tglb_cul_diar.Value = True Then
last_cell
.Range("A" & lj) = "CUL-DR"
End If
If Me.tglb_hpl_diar.Value = True Then
last_cell
.Range("A" & lj) = "HPL-DR"
End If
If Me.tglb_rpl_diar.Value = True Then
last_cell
.Range("A" & lj) = "RPL-DR"
End If
If Me.tglb_wpl_diar.Value = True Then
last_cell
.Range("A" & lj) = "WPL-DR"
End If
'Trn Diamonds
If Me.tglb_cue_diat.Value = True Then
last_cell
.Range("A" & lj) = "CUE-DT"
End If
If Me.tglb_hpe_diat.Value = True Then
last_cell
.Range("A" & lj) = "HPE-DT"
End If
If Me.tglb_rpe_diat.Value = True Then
last_cell
.Range("A" & lj) = "RPE-DT"
End If
If Me.tglb_wpe_diat.Value = True Then
last_cell
.Range("A" & lj) = "WPE-DT"
End If
If Me.tglb_cul_diat.Value = True Then
last_cell
.Range("A" & lj) = "CUL-DT"
End If
If Me.tglb_hpl_diat.Value = True Then
last_cell
.Range("A" & lj) = "HPL-DT"
End If
If Me.tglb_rpl_diat.Value = True Then
last_cell
.Range("A" & lj) = "RPL-DT"
End If
If Me.tglb_wpl_diat.Value = True Then
last_cell
.Range("A" & lj) = "WPL-DT"
End If
'Reg Fields
If Me.tglb_cue_fldr.Value = True Then
last_cell
.Range("A" & lj) = "CUE-FR"
End If
If Me.tglb_hpe_fldr.Value = True Then
last_cell
.Range("A" & lj) = "HPE-FR"
End If
If Me.tglb_rpe_fldr.Value = True Then
last_cell
.Range("A" & lj) = "RPE-FR"
End If
If Me.tglb_wpe_fldr.Value = True Then
last_cell
.Range("A" & lj) = "WPE-FR"
End If
If Me.tglb_cul_fldr.Value = True Then
last_cell
.Range("A" & lj) = "CUL-FR"
End If
If Me.tglb_hpl_fldr.Value = True Then
last_cell
.Range("A" & lj) = "HPL-FR"
End If
If Me.tglb_rpl_fldr.Value = True Then
last_cell
.Range("A" & lj) = "RPL-FR"
End If
If Me.tglb_wpl_fldr.Value = True Then
last_cell
.Range("A" & lj) = "WPL-FR"
End If
'Trn Fields
If Me.tglb_cue_fldt.Value = True Then
last_cell
.Range("A" & lj) = "CUE-FT"
End If
If Me.tglb_hpe_fldt.Value = True Then
last_cell
.Range("A" & lj) = "HPE-FT"
End If
If Me.tglb_rpe_fldt.Value = True Then
last_cell
.Range("A" & lj) = "RPE-FT"
End If
If Me.tglb_wpe_fldt.Value = True Then
last_cell
.Range("A" & lj) = "WPE-FT"
End If
If Me.tglb_cul_fldt.Value = True Then
last_cell
.Range("A" & lj) = "CUL-FT"
End If
If Me.tglb_hpl_fldt.Value = True Then
last_cell
.Range("A" & lj) = "HPL-FT"
End If
If Me.tglb_rpl_fldt.Value = True Then
last_cell
.Range("A" & lj) = "RPL-FT"
End If
If Me.tglb_wpl_fldt.Value = True Then
last_cell
.Range("A" & lj) = "WPL-FT"
End If
'Reg Courts
If Me.tglb_cue_crtr.Value = True Then
last_cell
.Range("A" & lj) = "CUE-CR"
End If
If Me.tglb_hpe_crtr.Value = True Then
last_cell
.Range("A" & lj) = "HPE-CR"
End If
If Me.tglb_rpe_crtr.Value = True Then
last_cell
.Range("A" & lj) = "RPE-CR"
End If
If Me.tglb_wpe_crtr.Value = True Then
last_cell
.Range("A" & lj) = "WPE-CR"
End If
If Me.tglb_cul_crtr.Value = True Then
last_cell
.Range("A" & lj) = "CUL-CR"
End If
If Me.tglb_hpl_crtr.Value = True Then
last_cell
.Range("A" & lj) = "HPL-CR"
End If
If Me.tglb_rpl_crtr.Value = True Then
last_cell
.Range("A" & lj) = "RPL-CR"
End If
If Me.tglb_wpl_crtr.Value = True Then
last_cell
.Range("A" & lj) = "WPL-CR"
End If
'Trn Courts
If Me.tglb_cue_crtt.Value = True Then
last_cell
.Range("A" & lj) = "CUE-CT"
End If
If Me.tglb_hpe_crtt.Value = True Then
last_cell
.Range("A" & lj) = "HPE-CT"
End If
If Me.tglb_rpe_crtt.Value = True Then
last_cell
.Range("A" & lj) = "RPE-CT"
End If
If Me.tglb_wpe_crtt.Value = True Then
last_cell
.Range("A" & lj) = "WPE-CT"
End If
If Me.tglb_cul_crtt.Value = True Then
last_cell
.Range("A" & lj) = "CUL-CT"
End If
If Me.tglb_hpl_crtt.Value = True Then
last_cell
.Range("A" & lj) = "HPL-CT"
End If
If Me.tglb_rpl_crtt.Value = True Then
last_cell
.Range("A" & lj) = "RPL-CT"
End If
If Me.tglb_wpl_crtt.Value = True Then
last_cell
.Range("A" & lj) = "WPL-CT"
End If
End With
'create directory
path = "H:\PWS\Parks\Parks Operations\Sports\Sports15\WORKORDERS\"
dirname = Format(ws_vh.Range("B2"), "ddd dd-mmm-yy")
dest1 = path & dirname
On Error Resume Next
MkDir dest1
On Error GoTo 0
'how many reports in que
riq = WorksheetFunction.CountA(ws_th.Range("A2:A49")) + 1
'create reports
For i = 2 To riq
Me.tb_cur_rpt = Me.tb_cur_rpt + 1
rpt_od = ws_th.Range("A" & i)
If rpt_od = "CUE-DR" Then
Me.tglb_cue_diar.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUL-DR" Then
Me.tglb_cul_diar.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPE-DR" Then
Me.tglb_hpe_diar.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPL-DR" Then
Me.tglb_hpl_diar.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPE-DR" Then
Me.tglb_rpe_diar.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPL-DR" Then
Me.tglb_rpl_diar.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPE-DR" Then
Me.tglb_wpe_diar.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPL-DR" Then
Me.tglb_wpl_diar.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUE-DT" Then
Me.tglb_cue_diat.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUL-DT" Then
Me.tglb_cul_diat.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPE-DT" Then
Me.tglb_hpe_diat.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPL-DT" Then
Me.tglb_hpl_diat.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPE-DT" Then
Me.tglb_rpe_diat.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPL-DT" Then
Me.tglb_rpl_diat.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPE-DT" Then
Me.tglb_wpe_diat.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPL-DT" Then
Me.tglb_wpl_diat.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUE-FR" Then
Me.tglb_cue_fldr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUL-FR" Then
Me.tglb_cul_fldr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPE-FR" Then
Me.tglb_hpe_fldr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPL-FR" Then
Me.tglb_hpl_fldr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPE-FR" Then
Me.tglb_rpe_fldr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPL-FR" Then
Me.tglb_rpl_fldr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPE-FR" Then
Me.tglb_wpe_fldr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPL-FR" Then
Me.tglb_wpl_fldr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUE-FT" Then
Me.tglb_cue_fldt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUL-FT" Then
Me.tglb_cul_fldt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPE-FT" Then
Me.tglb_hpe_fldt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPL-FT" Then
Me.tglb_hpl_fldt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPE-FT" Then
Me.tglb_rpe_fldt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPL-DT" Then
Me.tglb_rpl_fldt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPE-FT" Then
Me.tglb_wpe_fldt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPL-FT" Then
Me.tglb_wpl_fldt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUE-CR" Then
Me.tglb_cue_crtr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUL-CR" Then
Me.tglb_cul_crtr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPE-CR" Then
Me.tglb_hpe_crtr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPL-CR" Then
Me.tglb_hpl_crtr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPE-CR" Then
Me.tglb_rpe_crtr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPL-CR" Then
Me.tglb_rpl_crtr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPE-CR" Then
Me.tglb_wpe_diar.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPL-CR" Then
Me.tglb_wpl_crtr.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUE-CT" Then
Me.tglb_cue_crtt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "CUL-CT" Then
Me.tglb_cul_crtt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPE-CT" Then
Me.tglb_hpe_crtt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "HPL-CT" Then
Me.tglb_hpl_crtt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPE-CT" Then
Me.tglb_rpe_crtt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "RPL-CT" Then
Me.tglb_rpl_crtt.BackColor = RGB(229, 38, 38)
ElseIf rpt_od = "WPE-CT" Then
Me.tglb_wpe_crtt.BackColor = RGB(229, 38, 38)
Else
Me.tglb_wpl_crtt.BackColor = RGB(229, 38, 38)
End If
merge2 i, ws_vh, rpt_od, objWord ', pr, pn, path_name '[module 39]
On Error Resume Next
fn99 = ws_vh.Range("B4")
Set wBook = Workbooks(fn99)
If wBook Is Nothing Then
'open workbook after having been closed during report making
Workbooks.Open ("H:\PWS\Parks\Parks Operations\Sports\Sports15\DATA1\" & fn99)
ActiveWorkbook.Windows(1).Visible = False
Set wBook = Nothing
On Error GoTo 0
End If
On Error GoTo 0
If rpt_od = "CUE-DR" Then
Me.tglb_cue_diar.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUL-DR" Then
Me.tglb_cul_diar.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPE-DR" Then
Me.tglb_hpe_diar.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPL-DR" Then
Me.tglb_hpl_diar.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "rPE-DR" Then
Me.tglb_rpe_diar.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "rPL-DR" Then
Me.tglb_rpl_diar.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPE-DR" Then
Me.tglb_wpe_diar.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPL-DR" Then
Me.tglb_wpl_diar.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUE-DT" Then
Me.tglb_cue_diat.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUL-DT" Then
Me.tglb_cul_diat.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPE-DT" Then
Me.tglb_hpe_diat.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPL-DT" Then
Me.tglb_hpl_diat.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "RPE-DT" Then
Me.tglb_rpe_diat.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "RPL-DT" Then
Me.tglb_rpl_diat.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPE-DT" Then
Me.tglb_wpe_diat.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPL-DT" Then
Me.tglb_wpl_diat.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUE-FR" Then
Me.tglb_cue_fldr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUL-FR" Then
Me.tglb_cul_fldr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPE-FR" Then
Me.tglb_hpe_fldr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPL-FR" Then
Me.tglb_hpl_fldr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "RPE-FR" Then
Me.tglb_rpe_fldr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "RPL-FR" Then
Me.tglb_rpl_fldr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPE-FR" Then
Me.tglb_wpe_fldr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPL-FR" Then
Me.tglb_wpl_fldr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUE-FT" Then
Me.tglb_cue_fldt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUL-FT" Then
Me.tglb_cul_fldt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPE-FT" Then
Me.tglb_hpe_fldt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPL-FT" Then
Me.tglb_hpl_fldt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "RPE-FT" Then
Me.tglb_rpe_fldt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "RPL-DT" Then
Me.tglb_rpl_fldt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPE-FT" Then
Me.tglb_wpe_fldt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPL-FT" Then
Me.tglb_wpl_fldt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUE-CR" Then
Me.tglb_cue_crtr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUL-CR" Then
Me.tglb_cul_crtr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPE-CR" Then
Me.tglb_hpe_crtr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPL-CR" Then
Me.tglb_hpl_crtr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "RPE-CR" Then
Me.tglb_rpe_crtr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "RPL-CR" Then
Me.tglb_rpl_crtr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPE-CR" Then
Me.tglb_wpe_diar.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPL-CR" Then
Me.tglb_wpl_crtr.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUE-CT" Then
Me.tglb_cue_crtt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "CUL-CT" Then
Me.tglb_cul_crtt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPE-CT" Then
Me.tglb_hpe_crtt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "HPL-CT" Then
Me.tglb_hpl_crtt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "RPE-CT" Then
Me.tglb_rpe_crtt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "RPL-CT" Then
Me.tglb_rpl_crtt.BackColor = RGB(0, 153, 0)
ElseIf rpt_od = "WPE-CT" Then
Me.tglb_wpe_crtt.BackColor = RGB(0, 153, 0)
Else
Me.tglb_wpl_crtt.BackColor = RGB(0, 153, 0)
End If
MsgBox "Report for " & rpt_od & " completed.", vbInformation, "SUCCESS"
Me.tb_of_rpt = Me.tb_of_rpt - 1
ws_th.Range("A" & i) = ""
Next i
MsgBox Me.tb_cur_rpt.Value & " report(s) created and saved.", vbInformation, "SUCCESS"
objWord.Quit
Set objWord = Nothing
End Sub
It's not quite right either. If I just wish to print one report, it insists on merging more reports that requested. It seems to compound the more times I print individually.