paulked
03-06-2017, 07:07 AM
Hi all.
When i run this...
Sub PrintLeague()
Application.ScreenUpdating = False
Dim i As Integer
Dim rsp As String
Dim lr As Long
Dim shRes As Worksheet, shPrt As Worksheet
Set shRes = ThisWorkbook.Worksheets("Results")
Set shPrt = ThisWorkbook.Worksheets("Print")
rsp = MsgBox("Do you want to include the last three games?", vbYesNo, "Include games?")
shPrt.Rows("22:29").ClearContents
If rsp = vbYes Then
lr = shRes.Cells(shRes.Rows.Count, "C").End(xlUp).Row
shRes.Range("A" & lr - 27).Copy
shPrt.Range("D22").PasteSpecial
shRes.Range("B" & lr - 26 & ":B" & lr - 20).Copy
shPrt.Range("A23").PasteSpecial Paste:=xlPasteValues
shRes.Range("C" & lr - 26 & ":E" & lr - 20).Copy
shPrt.Range("D23").PasteSpecial Paste:=xlPasteValues
shRes.Range("F" & lr - 26 & ":F" & lr - 20).Copy
shPrt.Range("I23").PasteSpecial Paste:=xlPasteValues
shRes.Range("A" & lr - 17).Copy
shPrt.Range("N22").PasteSpecial
shRes.Range("B" & lr - 16 & ":B" & lr - 10).Copy
shPrt.Range("K23").PasteSpecial Paste:=xlPasteValues
shRes.Range("C" & lr - 16 & ":E" & lr - 10).Copy
shPrt.Range("N23").PasteSpecial Paste:=xlPasteValues
shRes.Range("F" & lr - 16 & ":F" & lr - 10).Copy
shPrt.Range("S23").PasteSpecial Paste:=xlPasteValues
shRes.Range("A" & lr - 7).Copy
shPrt.Range("X22").PasteSpecial
shRes.Range("B" & lr - 6 & ":B" & lr).Copy
shPrt.Range("U23").PasteSpecial Paste:=xlPasteValues
shRes.Range("C" & lr - 6 & ":E" & lr).Copy
shPrt.Range("X23").PasteSpecial Paste:=xlPasteValues
shRes.Range("F" & lr - 6 & ":F" & lr).Copy
shPrt.Range("AC23").PasteSpecial Paste:=xlPasteValues
End If
Sheets("Table").Range("E3:T18").Copy
shPrt.Range("H5").PasteSpecial Paste:=xlPasteValues
For lr = 5 To 20
If shPrt.Range("H" & lr) = "" Then Exit For
Next
lr = lr - 1
shPrt.Sort.SortFields.Clear
shPrt.Sort.SortFields.Add Key:=Range("W5:W20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
shPrt.Sort.SortFields.Add Key:=Range("V5:V20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With shPrt.Sort
.SetRange Range("F4:W" & lr)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
shPrt.PrintPreview
End Sub
the "Format Shape" window opens.
I am using TextBox's as 'buttons' to call subs, but they don't sit on any of the ranges I'm selecting.
Any ideas?
Many thanks
Paul Ked
When i run this...
Sub PrintLeague()
Application.ScreenUpdating = False
Dim i As Integer
Dim rsp As String
Dim lr As Long
Dim shRes As Worksheet, shPrt As Worksheet
Set shRes = ThisWorkbook.Worksheets("Results")
Set shPrt = ThisWorkbook.Worksheets("Print")
rsp = MsgBox("Do you want to include the last three games?", vbYesNo, "Include games?")
shPrt.Rows("22:29").ClearContents
If rsp = vbYes Then
lr = shRes.Cells(shRes.Rows.Count, "C").End(xlUp).Row
shRes.Range("A" & lr - 27).Copy
shPrt.Range("D22").PasteSpecial
shRes.Range("B" & lr - 26 & ":B" & lr - 20).Copy
shPrt.Range("A23").PasteSpecial Paste:=xlPasteValues
shRes.Range("C" & lr - 26 & ":E" & lr - 20).Copy
shPrt.Range("D23").PasteSpecial Paste:=xlPasteValues
shRes.Range("F" & lr - 26 & ":F" & lr - 20).Copy
shPrt.Range("I23").PasteSpecial Paste:=xlPasteValues
shRes.Range("A" & lr - 17).Copy
shPrt.Range("N22").PasteSpecial
shRes.Range("B" & lr - 16 & ":B" & lr - 10).Copy
shPrt.Range("K23").PasteSpecial Paste:=xlPasteValues
shRes.Range("C" & lr - 16 & ":E" & lr - 10).Copy
shPrt.Range("N23").PasteSpecial Paste:=xlPasteValues
shRes.Range("F" & lr - 16 & ":F" & lr - 10).Copy
shPrt.Range("S23").PasteSpecial Paste:=xlPasteValues
shRes.Range("A" & lr - 7).Copy
shPrt.Range("X22").PasteSpecial
shRes.Range("B" & lr - 6 & ":B" & lr).Copy
shPrt.Range("U23").PasteSpecial Paste:=xlPasteValues
shRes.Range("C" & lr - 6 & ":E" & lr).Copy
shPrt.Range("X23").PasteSpecial Paste:=xlPasteValues
shRes.Range("F" & lr - 6 & ":F" & lr).Copy
shPrt.Range("AC23").PasteSpecial Paste:=xlPasteValues
End If
Sheets("Table").Range("E3:T18").Copy
shPrt.Range("H5").PasteSpecial Paste:=xlPasteValues
For lr = 5 To 20
If shPrt.Range("H" & lr) = "" Then Exit For
Next
lr = lr - 1
shPrt.Sort.SortFields.Clear
shPrt.Sort.SortFields.Add Key:=Range("W5:W20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
shPrt.Sort.SortFields.Add Key:=Range("V5:V20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With shPrt.Sort
.SetRange Range("F4:W" & lr)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
shPrt.PrintPreview
End Sub
the "Format Shape" window opens.
I am using TextBox's as 'buttons' to call subs, but they don't sit on any of the ranges I'm selecting.
Any ideas?
Many thanks
Paul Ked