Changing a Cell Value in Multiple Sheets

  • Thread starter Thread starter John Skalla
  • Start date Start date
J

John Skalla

My Workbook contains eight Worksheets. In many places in the Workbook are
two cells arranged beside each other. The left cell is has the text 'EMO' in
it; the right cell has a particular number in it. I want to do a global
replacement of the number that has a value of .78 times the original number.
Is there a global search/replace function, or a macro that would do the
trick?

Thanks for any help...

John
 
Sub AdjustNumber()
Dim sh As Worksheet
Dim rng As Range
Dim sAddr As String
For Each sh In ActiveWorkbook.Worksheets
Set rng = sh.Cells.Find(What:="EMO", _
After:=sh.Range("IV65536"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
rng.Offset(0, 1).Value = rng.Offset(0, 1).Value * 0.78
Set rng = sh.Cells.FindNext(rng)
Loop While Not rng.Address = sAddr
End If
Next

End Sub
 
Hi John

Try this one for the activesheet

Sub test()
Dim FirstAddress As String
Dim rng As Range

Application.ScreenUpdating = False
With ActiveSheet.Cells
Set rng = .Find(What:="EMO", After:=Range("IV" & Rows.Count),
LookAt:=xlWhole)
'If you want to search in a part of the rng.value then use
xlPart
If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
rng.Offset(0, 1).Value = rng.Offset(0, 1).Value * 0.78
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <>
FirstAddress
End If
End With
Application.ScreenUpdating = True
End Sub
 
I changed my OE setting so I hope this is reading better

Sub test()
Dim FirstAddress As String
Dim rng As Range

Application.ScreenUpdating = False
With ActiveSheet.Cells
Set rng = .Find(What:="EMO", After:=Range("IV" & Rows.Count) _
, LookAt:=xlWhole)
'If you want to search in a part of the rng.value then use xlPart
If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
rng.Offset(0, 1).Value = rng.Offset(0, 1).Value * 0.78
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> FirstAddress
End If
End With
Application.ScreenUpdating = True
End Sub
 
Back
Top