Macro Troubleshooting---Multiple Ifs

[Wildcats23]

A	B	C
	Tests
	410--Troubleshoot Test
	410
	Troubleshoot Test
	873---Water Pressure Test
	Water Pressure Test
	873

<tbody>
</tbody>

Hello,
The problem I'm having is that I have a column (Column B) of about 30 different tests that are supposed to only be categorized as numbers...... however there has been a lot of mislabeling in my data sample. I provided a small example of what I mean in the table above. What I would like the Macro to do is filter the column so if it sees (For Example) "water pressure test" or "873---Water Test" It will replace it with just "873". I have a lot of different tests so a find and replace would take too long and I would have to continually redo it every time I update the data (weekly basis). I would like to write one big macro so I never have to do that again. THANK YOU!!!!

 

[Yongle]

Excel 2016 (Windows) 32 bit

	A​	B​
1​	​	Tests​
2​	​	410--Troubleshoot Test​
3​	​	410​
4​	​	Troubleshoot Test​
5​	​	873---Water Pressure Test​
6​	​	Water Pressure Test​
7​	​	873​

Sheet: Data

Excel 2016 (Windows) 32 bit

	A​	B​
1​	Look For​	Replacement​
2​	410​	410​
3​	410--Troubleshoot Test​	410​
4​	Troubleshoot Test​	410​
5​	873​	873​
6​	873---Water Pressure Test​	873​
7​	Water Pressure Test​	873​
8​

Sheet: LookUp

Add worksheet with replacement lookup values
- include all values you expect to see in the column

Paste code into standard module and amend sheet names

Option Explicit

Sub ReplaceValues()
 Application.ScreenUpdating = False
    
    Dim Valu, Orig As Range, cel As Range, LookUpRng As Range, Msg As String, Ws As Worksheet
    Set LookUpRng = Sheets("Lookup").Range("A:B")
        
    With Sheets("[COLOR=#ff0000]Data[/COLOR]")
        Set Orig = .Range("[COLOR=#ff0000]B2[/COLOR]", .Range("[COLOR=#ff0000]B[/COLOR]" & Rows.Count).End(xlUp))
            For Each cel In Orig
            On Error Resume Next
                Valu = WorksheetFunction.VLookup(cel, LookUpRng, 2, 0)
                    If Err.Number > 0 Then
                        Msg = Msg & vbCr & cel
                    Else
                        cel = Valu
                    End If
                On Error GoTo 0
            Next cel
    End With
 Application.ScreenUpdating = True
 If Msg <> "" Then MsgBox Msg, vbInformation, "NOT FOUND"
End Sub

 

[Wildcats23]

That worked great, Thank you very much!!!

 

[Yongle]

thanks for the feedback