ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   Command Button Error - Help Needed Urgently Please (https://www.excelbanter.com/excel-worksheet-functions/133695-command-button-error-help-needed-urgently-please.html)

Salman
Command Button Error - Help Needed Urgently Please
 
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

joel
Command Button Error - Help Needed Urgently Please
 
I don't know what the data on the worksheet should look like. but was able to
step through code with only one error. The On Error statement is in the
wrong location. You also shouold return the error checking back to normal
with the On Error go to 0 statement.

For iRow = FirstRow To LastRow
HowMany = .Cells(iRow, "v").Value
On Error Resume Next

DestCell.Resize(HowMany, 1).Value = .Cells(iRow, "w").Value
Set DestCell = DestCell.Offset(HowMany, 0)
On Error GoTo 0 ' return to normal error checking

Next iRow


"Salman" wrote:

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

Salman
Command Button Error - Help Needed Urgently Please
 
noted and corrected thanks

but for now the main issue is that button is in "Summary" Sheet and that
code u have corrected have to run in another sheet "Scrip Position" after
clicking command button nothing happens else than re-formatting on the same
sheet i.e. "Summary".
"Scrip Position" is linked with several other sheets and loosing data if try
to format and subtotal there, dont know why, thats y extracting data to
another sheet after running first part of the code
But first part of the code not working through Command button , although
whole code works great (on both sheets) if run through macro.

"Joel" wrote:

I don't know what the data on the worksheet should look like. but was able to
step through code with only one error. The On Error statement is in the
wrong location. You also shouold return the error checking back to normal
with the On Error go to 0 statement.

For iRow = FirstRow To LastRow
HowMany = .Cells(iRow, "v").Value
On Error Resume Next

DestCell.Resize(HowMany, 1).Value = .Cells(iRow, "w").Value
Set DestCell = DestCell.Offset(HowMany, 0)
On Error GoTo 0 ' return to normal error checking

Next iRow


"Salman" wrote:

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


All times are GMT +1. The time now is 10:36 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com