Cell Values

J

Jenawade

Board Regular
Joined
Apr 8, 2002
Messages
231
The macro below selects a range, searches for 130620, 130618, 133362,130604, and if found, changes any instance of "BLUE" or "ORANGE" to "BLACK;" however, the user noticed that if the cell that contains 1 of those 4 numbers contains ONLY that number, "BLUE" or "ORANGE" are not updated - but if the cell contains any text or numbers along with 1 of those 4 numbers, it works. Can anyone help me tweak this so it will work when any of those 4 numbers are within the range, whether alone or as part of a string?

Code: 
Sub UpdateLabels()

Dim fn As Variant, f As Integer

    fn = Application.GetOpenFilename("Excel-files,*.xls", _
        1, "Select One Or More Files To Open", , True)
    If TypeName(fn) = "Boolean" Then Exit Sub
    For f = 1 To UBound(fn)
        Debug.Print "Selected file #" & f & ": " & fn(f)
        Workbooks.Open fn(f)

               On Error Resume Next
               
               With Range("A40:Z90")
               
               r = .find(130620, LookIn:=xlValues)
               s = .find(130618, LookIn:=xlValues)
               t = .find(133362, LookIn:=xlValues)
               u = .find(130604, LookIn:=xlValues)

               If Not r = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not r = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not r = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not r = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               End With

       ActiveWorkbook.Close savechanges:=True

   Next f

MsgBox "Completed", vbInformation
    
End Sub

Thanks!
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
Jenawade said:
The macro below selects a range, searches for 130620, 130618, 133362,130604, and if found, changes any instance of "BLUE" or "ORANGE" to "BLACK;" however, the user noticed that if the cell that contains 1 of those 4 numbers contains ONLY that number, "BLUE" or "ORANGE" are not updated - but if the cell contains any text or numbers along with 1 of those 4 numbers, it works. Can anyone help me tweak this so it will work when any of those 4 numbers are within the range, whether alone or as part of a string?

Code: 
Sub UpdateLabels()

Dim fn As Variant, f As Integer

    fn = Application.GetOpenFilename("Excel-files,*.xls", _
        1, "Select One Or More Files To Open", , True)
    If TypeName(fn) = "Boolean" Then Exit Sub
    For f = 1 To UBound(fn)
        Debug.Print "Selected file #" & f & ": " & fn(f)
        Workbooks.Open fn(f)

               On Error Resume Next
               
               With Range("A40:Z90")
               
               r = .find(130620, LookIn:=xlValues)
               s = .find(130618, LookIn:=xlValues)
               t = .find(133362, LookIn:=xlValues)
               u = .find(130604, LookIn:=xlValues)

               If Not r = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not r = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not r = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not r = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               End With

       ActiveWorkbook.Close savechanges:=True

   Next f

MsgBox "Completed", vbInformation
    
End Sub

Thanks!
Click to expand...

Maybe:

Code: 
Sub UpdateLabels()

Dim fn As Variant, f As Integer

    fn = Application.GetOpenFilename("Excel-files,*.xls", _
        1, "Select One Or More Files To Open", , True)
    If TypeName(fn) = "Boolean" Then Exit Sub
    For f = 1 To UBound(fn)
        Debug.Print "Selected file #" & f & ": " & fn(f)
        Workbooks.Open fn(f)

               On Error Resume Next
               
               With Range("A40:Z90")
               
               r = .Find(130620, LookIn:=xlValues)
               s = .Find(130618, LookIn:=xlValues)
               t = .Find(133362, LookIn:=xlValues)
               u = .Find(130604, LookIn:=xlValues)

               If Not r = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlPart
               If Not r = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlPart
               If Not r = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlPart
               If Not r = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               If Not s = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               If Not t = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               If Not u = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlPart
               If Not r = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlWhole
               If Not s = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlWhole
               If Not t = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlWhole
               If Not u = "" Then .Replace What:="BLUE", Replacement:="BLACK", LookAt:=xlWhole
               If Not r = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlWhole
               If Not s = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlWhole
               If Not t = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlWhole
               If Not u = "" Then .Replace What:="ORANGE", Replacement:="BLACK", LookAt:=xlWhole
               If Not r = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlWhole
               If Not s = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlWhole
               If Not t = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlWhole
               If Not u = "" Then .Replace What:="GREEN", Replacement:="BLACK", LookAt:=xlWhole
               If Not r = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlWhole
               If Not s = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlWhole
               If Not t = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlWhole
               If Not u = "" Then .Replace What:="RED", Replacement:="BLACK", LookAt:=xlWhole
               
               
               End With

       ActiveWorkbook.Close savechanges:=True

   Next f

MsgBox "Completed", vbInformation
    
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Locked
  • Question Question
Macros and protecting a cell
Replies
5
Views
112
Fluff
Fluff
Q
  • Question Question
use row number as reference for edit value in a row VBA
Replies
4
Views
296
Alex Blakenburg
A
J
  • Question Question
search all worksheets based upon textbox value and add to listbox
Replies
7
Views
408
Jaye7
J
SanjayGMusafir
  • Solved
VBA to search Excel by Field Input Values
Replies
3
Views
498
kevin9999
K
Z
  • Solved
VBA not copying cell value when running it on certain files
Replies
2
Views
487
zack8576
Z

Forum statistics

Threads
1,224,582
Messages
6,179,670
Members
452,936
Latest member
anamikabhargaw

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top