Update all sheets in a workbook

[Les]

I am using the code below to update sheets on beforesave. Although this is
in the Workbook command it only updates the open sheet. Is there a way to
force it to update all sheets before saving. It works if I selects all the
sheets first.

Thanks

Les

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim Commvalue As Integer
Dim Poss As String
Dim Percnt As String

On Error GoTo HandleErr

Cells.Find(What:="TOTAL RPP", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate

ActiveCell.Offset(, columnOffset:=2).Activate
'ActiveCell.Select
Poss = ActiveCell.Address

'Range(Poss).Select
Commvalue = Range(Poss)

ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Percnt = ActiveCell.Address

Select Case Commvalue

Case Is >= 5000
Range(Percnt) = 0.15

Case Is < 50
Range(Percnt) = 0

Case Is < 1000
Debug.Print Commvalue
Range(Percnt) = 0.05

Case Is < 2000
Range(Percnt) = 0.07

Case Is < 3000
Range(Percnt) = 0.09

Case Is < 4000
Range(Percnt) = 0.11

Case Is < 5000
Range(Percnt) = 0.13

Case Else

Range(Percnt) = 0

End Select

ExitHere:
Exit Sub

HandleErr:
Select Case Err.Number
Case Else
MsgBox "This Sheet Does Not Have A Cell Titled 'Total RRP' So
Calculations Could be Incorrect Please Check After Saving", , "No RRP"
End Select
Resume ExitHere
End Sub

 

[Vasant Nanavati]

Quick fix (although there are better ways to do this):

Dim ws As Worksheet '++++++

For Each ws In Worksheets '++++++

ws.Select '++++++

Cells.Find(What:="TOTAL RPP", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate

ActiveCell.Offset(, columnOffset:=2).Activate
'ActiveCell.Select
Poss = ActiveCell.Address

'Range(Poss).Select
Commvalue = Range(Poss)

ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Percnt = ActiveCell.Address

Select Case Commvalue

Case Is >= 5000
Range(Percnt) = 0.15

Case Is < 50
Range(Percnt) = 0

Case Is < 1000
Debug.Print Commvalue
Range(Percnt) = 0.05

Case Is < 2000
Range(Percnt) = 0.07

Case Is < 3000
Range(Percnt) = 0.09

Case Is < 4000
Range(Percnt) = 0.11

Case Is < 5000
Range(Percnt) = 0.13

Case Else

Range(Percnt) = 0

End Select

Next '++++++

Lines commented with '++++++ added by me.

How will you make sure that the right cell is the active cell on all the
sheets (when running Find)?

 

[Les]

Thanks for that now working fine

Les

Quick fix (although there are better ways to do this):

Dim ws As Worksheet '++++++

For Each ws In Worksheets '++++++

ws.Select '++++++

Cells.Find(What:="TOTAL RPP", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate

ActiveCell.Offset(, columnOffset:=2).Activate
'ActiveCell.Select
Poss = ActiveCell.Address

'Range(Poss).Select
Commvalue = Range(Poss)

ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Percnt = ActiveCell.Address

Select Case Commvalue

Case Is >= 5000
Range(Percnt) = 0.15

Case Is < 50
Range(Percnt) = 0

Case Is < 1000
Debug.Print Commvalue
Range(Percnt) = 0.05

Case Is < 2000
Range(Percnt) = 0.07

Case Is < 3000
Range(Percnt) = 0.09

Case Is < 4000
Range(Percnt) = 0.11

Case Is < 5000
Range(Percnt) = 0.13

Case Else

Range(Percnt) = 0

End Select

Next '++++++

Lines commented with '++++++ added by me.

How will you make sure that the right cell is the active cell on all the
sheets (when running Find)?

--

Vasant



LookAt

 

[BrianB]

REVISED VERSION :-

'------------------------------------------
Private Sub Workbook_BeforeSave(ByVal _
SaveAsUI As Boolean, Cancel As Boolean)
Dim Commvalue As Integer
'Dim Poss As String
Dim Percnt As Range
Dim FoundCell As Object
'----------------------------------------
For Each ws In ActiveWorkbook.Worksheets
Set FoundCell = ws.Cells.Find(What:="TOTAL RPP"
After:=ws.Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows
SearchDirection:=xlNext)
'-
If FoundCell Is Nothing Then
rsp = MsgBox(UCase(ws.Name) & vbCr _
& "This Sheet Does Not Have A Cell Titled 'Total RRP'"
vbCr _
& "So Calculations Could be Incorrect. Please Check Afte
Saving", , "No RRP")
Else
Commvalue = FoundCell.Offset(, columnOffset:=2).Value
Set Percnt = FoundCell.Offset(rowOffset:=1, columnOffset:=0)
'-
Select Case Commvalue
Case Is >= 5000
Percnt.Value = 0.15
'-
Case Is < 50
Percnt.Value = 0
'-
Case Is < 1000
Debug.Print Commvalue
Percnt.Value = 0.05
'-
Case Is < 2000
Percnt.Value = 0.07
'-
Case Is < 3000
Percnt.Value = 0.09
'-
Case Is < 4000
Percnt.Value = 0.11
'-
Case Is < 5000
Percnt.Value = 0.13
'-
Case Else
Percnt.Value = 0
End Select
End If
Next
End Sub
'------------------------------------------------