lilstevie
04-29-2008, 06:48 PM
:banghead: This is killing me, I'm sure that it is something stupid that I've overlooked.
I have a userform that runs a filter on a ws (combined data) and then copies the filtered data to another ws(comments) and 'hopefully' prints up the updated comments(ws). The problem is that the print area of the comments ws will not set for me. Sometimes the code works perfectly sometimes it only finds the top 4 rows (or header section). Please help!
Here is the code:
Private Sub cmdCreateReport_Click()
Dim i As Long, msg As String, Check As String
Dim LR As Long, LR2 As Long, rng2 As Range
Dim lastrow2 As Long
Dim endrange As String
'check for blanks
If Me.tbxSTARTDATE.Value = "SELECT DATE" Then
MsgBox "Please select the report START date!", vbOKOnly, "Enter start date"
Me.cmdCreateReport.Enabled = False
Me.tbxSTARTDATE.SetFocus
Exit Sub
End If
If Me.tbxENDDATE.Enabled = True And Me.tbxENDDATE.Value = "SELECT DATE" Then
MsgBox "Please select the report end date!", vbOKOnly, "Enter end date"
Me.cmdCreateReport.Enabled = False
Me.tbxENDDATE.SetFocus
Exit Sub
End If
If Me.lstbxEmployeeName.ListIndex = -1 Then
MsgBox "Please select employee name!", vbOKOnly, "Select Employee"
Me.cmdCreateReport.Enabled = False
Me.lstbxEmployeeName.SetFocus
Exit Sub
Else
'Ask the user if they are happy with their selection(s)
Check = MsgBox("You selected:" & vbNewLine & Me.lstbxEmployeeName.Value & vbNewLine & _
"Are you happy with your selection?", _
vbYesNo + vbInformation, "Please confirm")
End If
If Check = vbYes Then
rptempname = Me.lstbxEmployeeName.Value
Unload Me
With Sheet8
.AutoFilterMode = False
With .Range("A5:k6")
.AutoFilter
.AutoFilter Field:=4, Criteria1:=">=" & rptstartdate, Operator:=xlAnd, Criteria2:="<=" & rptenddate
.AutoFilter Field:=1, Criteria1:="=" & rptempname
.AutoFilter Field:=11, Criteria1:="<>"
End With
End With
Sheet8.Range("b1").Value = rptempname
Sheet8.Range("b2").Value = rptstartdate
Sheet8.Range("b3").Value = rptenddate
Sheet8.Range("k1").Value = "Comments for: " & rptempname
Sheet6.Range("a2").Value = rptempname
Sheet6.Range("a3").Value = rptstartdate & " to " & rptenddate
If Sheet8.Range("B4").Value = 0 Then
MsgBox "No comments for selected period" & vbNewLine & vbNewLine & " Please refine search criteria"
frmComments.Show
Exit Sub
Else
LR = Sheet8.Range("A" & Rows.Count).End(xlUp).Row
LR2 = Sheet6.Range("a" & Rows.Count).End(xlUp).Row
Sheet6.Range("A6:B" & LR2).Value = ""
With Sheet8.Range("d6:d" & LR)
.SpecialCells(xlCellTypeVisible).Copy
End With
Sheet6.Range("A6:a" & LR).PasteSpecial Paste:=xlPasteValues
With Sheet8.Range("k6:k" & LR)
.SpecialCells(xlCellTypeVisible).Copy
End With
Sheet6.Range("b6:b" & LR).PasteSpecial Paste:=xlPasteValues
End If
lastrow2 = Sheet6.Range("A" & Rows.Count).End(xlUp).Row
With Sheet6.Range("A6:B" & lastrow2)
.wraptext = True
.VerticalAlignment = xlTop
End With
With Sheet6.Range("$A$10000:B" & lastrow2 + 1)
.ClearContents
End With
Application.ScreenUpdating = True
endrange = Cells(Rows.Count, 2).End(xlUp).Address
Sheet6.PageSetup.PrintArea = "$A$1:" & endrange
Sheet6.PageSetup.PrintArea = "$A$1:" & endrange
Sheet6.PrintOut Copies:=1
protectall
End If
End Sub
I have a userform that runs a filter on a ws (combined data) and then copies the filtered data to another ws(comments) and 'hopefully' prints up the updated comments(ws). The problem is that the print area of the comments ws will not set for me. Sometimes the code works perfectly sometimes it only finds the top 4 rows (or header section). Please help!
Here is the code:
Private Sub cmdCreateReport_Click()
Dim i As Long, msg As String, Check As String
Dim LR As Long, LR2 As Long, rng2 As Range
Dim lastrow2 As Long
Dim endrange As String
'check for blanks
If Me.tbxSTARTDATE.Value = "SELECT DATE" Then
MsgBox "Please select the report START date!", vbOKOnly, "Enter start date"
Me.cmdCreateReport.Enabled = False
Me.tbxSTARTDATE.SetFocus
Exit Sub
End If
If Me.tbxENDDATE.Enabled = True And Me.tbxENDDATE.Value = "SELECT DATE" Then
MsgBox "Please select the report end date!", vbOKOnly, "Enter end date"
Me.cmdCreateReport.Enabled = False
Me.tbxENDDATE.SetFocus
Exit Sub
End If
If Me.lstbxEmployeeName.ListIndex = -1 Then
MsgBox "Please select employee name!", vbOKOnly, "Select Employee"
Me.cmdCreateReport.Enabled = False
Me.lstbxEmployeeName.SetFocus
Exit Sub
Else
'Ask the user if they are happy with their selection(s)
Check = MsgBox("You selected:" & vbNewLine & Me.lstbxEmployeeName.Value & vbNewLine & _
"Are you happy with your selection?", _
vbYesNo + vbInformation, "Please confirm")
End If
If Check = vbYes Then
rptempname = Me.lstbxEmployeeName.Value
Unload Me
With Sheet8
.AutoFilterMode = False
With .Range("A5:k6")
.AutoFilter
.AutoFilter Field:=4, Criteria1:=">=" & rptstartdate, Operator:=xlAnd, Criteria2:="<=" & rptenddate
.AutoFilter Field:=1, Criteria1:="=" & rptempname
.AutoFilter Field:=11, Criteria1:="<>"
End With
End With
Sheet8.Range("b1").Value = rptempname
Sheet8.Range("b2").Value = rptstartdate
Sheet8.Range("b3").Value = rptenddate
Sheet8.Range("k1").Value = "Comments for: " & rptempname
Sheet6.Range("a2").Value = rptempname
Sheet6.Range("a3").Value = rptstartdate & " to " & rptenddate
If Sheet8.Range("B4").Value = 0 Then
MsgBox "No comments for selected period" & vbNewLine & vbNewLine & " Please refine search criteria"
frmComments.Show
Exit Sub
Else
LR = Sheet8.Range("A" & Rows.Count).End(xlUp).Row
LR2 = Sheet6.Range("a" & Rows.Count).End(xlUp).Row
Sheet6.Range("A6:B" & LR2).Value = ""
With Sheet8.Range("d6:d" & LR)
.SpecialCells(xlCellTypeVisible).Copy
End With
Sheet6.Range("A6:a" & LR).PasteSpecial Paste:=xlPasteValues
With Sheet8.Range("k6:k" & LR)
.SpecialCells(xlCellTypeVisible).Copy
End With
Sheet6.Range("b6:b" & LR).PasteSpecial Paste:=xlPasteValues
End If
lastrow2 = Sheet6.Range("A" & Rows.Count).End(xlUp).Row
With Sheet6.Range("A6:B" & lastrow2)
.wraptext = True
.VerticalAlignment = xlTop
End With
With Sheet6.Range("$A$10000:B" & lastrow2 + 1)
.ClearContents
End With
Application.ScreenUpdating = True
endrange = Cells(Rows.Count, 2).End(xlUp).Address
Sheet6.PageSetup.PrintArea = "$A$1:" & endrange
Sheet6.PageSetup.PrintArea = "$A$1:" & endrange
Sheet6.PrintOut Copies:=1
protectall
End If
End Sub