Update all sheets in a workbook

  • Thread starter Thread starter Les
  • Start date Start date
L

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
 
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)?
 
Thanks for that now working fine

Les


Vasant Nanavati said:
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
Click to expand...
 
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
'------------------------------------------------
 
Back
Top