S
Salman
A. Below is the code that work perfectly when i run it through macro but not
working through command button, i have refer to other post but cant change it
as per my need, help required.
B. after running whole macro print area left the grand total out of the
range, if any correction needed, please advise.
Command button is at Summary Sheet where data is required and to be formatted.
below is the code:
Private Sub CommandButton1_Click()
Sheets("Scrip Position").Select
Range("B7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("C1").Select
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim HowMany As Long
Dim DestCell As Range
Set CurWks = Worksheets("Scrip Position")
Set NewWks = Worksheets("Scrip Position")
Set DestCell = NewWks.Range("B7")
With CurWks
FirstRow = 1 'no headers??
LastRow = .Cells(.Rows.Count, "w").End(xlUp).Row
For iRow = FirstRow To LastRow
HowMany = .Cells(iRow, "v").Value
DestCell.Resize(HowMany, 1).Value = .Cells(iRow, "w").Value
On Error Resume Next
Set DestCell = DestCell.Offset(HowMany, 0)
Next iRow
End With
Sheets("Summary").Select
Range("C1").Select
Selection.AutoFilter Field:=2
Cells.Select
Range("B1").Activate
Selection.RemoveSubtotal
Range("B5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4, 11,
14, _
15, 16), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Range("B5").Select
Selection.AutoFilter Field:=2, Criteria1:="=*Total*", Operator:=xlAnd
Rows("7:1046").Select
Range("B7").Activate
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=2, Criteria1:="=*Grand*", Operator:=xlAnd
Range("E996").Select
Selection.Font.ColorIndex = 2
Range("L996").Select
Selection.Font.ColorIndex = 2
Rows("519:519").Select
Range("B519").Activate
Selection.Interior.ColorIndex = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("B5").Select
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.End(xlDown).Select
'ActiveWindow.SmallScroll Down:=957
ActiveSheet.PageSetup.PrintArea = "$B$1:$Q$519"
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
End Sub
working through command button, i have refer to other post but cant change it
as per my need, help required.
B. after running whole macro print area left the grand total out of the
range, if any correction needed, please advise.
Command button is at Summary Sheet where data is required and to be formatted.
below is the code:
Private Sub CommandButton1_Click()
Sheets("Scrip Position").Select
Range("B7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("C1").Select
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim HowMany As Long
Dim DestCell As Range
Set CurWks = Worksheets("Scrip Position")
Set NewWks = Worksheets("Scrip Position")
Set DestCell = NewWks.Range("B7")
With CurWks
FirstRow = 1 'no headers??
LastRow = .Cells(.Rows.Count, "w").End(xlUp).Row
For iRow = FirstRow To LastRow
HowMany = .Cells(iRow, "v").Value
DestCell.Resize(HowMany, 1).Value = .Cells(iRow, "w").Value
On Error Resume Next
Set DestCell = DestCell.Offset(HowMany, 0)
Next iRow
End With
Sheets("Summary").Select
Range("C1").Select
Selection.AutoFilter Field:=2
Cells.Select
Range("B1").Activate
Selection.RemoveSubtotal
Range("B5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4, 11,
14, _
15, 16), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Range("B5").Select
Selection.AutoFilter Field:=2, Criteria1:="=*Total*", Operator:=xlAnd
Rows("7:1046").Select
Range("B7").Activate
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=2, Criteria1:="=*Grand*", Operator:=xlAnd
Range("E996").Select
Selection.Font.ColorIndex = 2
Range("L996").Select
Selection.Font.ColorIndex = 2
Rows("519:519").Select
Range("B519").Activate
Selection.Interior.ColorIndex = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("B5").Select
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.End(xlDown).Select
'ActiveWindow.SmallScroll Down:=957
ActiveSheet.PageSetup.PrintArea = "$B$1:$Q$519"
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
End Sub