Find and replace using cell contents as the search criteria

**Vlad717** · 03-07-2013, 04:48 PM

Hi everyone,

The scope of what I am trying to do is this ... There are two sheets, one holds a list of serial numbers in column A (Sheet2), and the other is essentially a packing slip (Sheet1). When a serial number is used in Sheet1, the goal is to have it search for that serial number on Sheet2 and replace it with a blank.

The problem I've encountered is that I can't find anywhere on the net on how to make the search criteria be cell dependent.

If this is how you normally find text to replace ...

ActiveCell.Replace What:="123456789", Replacement:=" ", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

How do I make it run so (in a crude sense) it functions as ... D5 being the cell that contains the serial number.

ActiveCell.Replace What:=D5, Replacement:=" ", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Any ideas?

Thanks,

**AlvaroSiza** · 03-07-2013, 04:53 PM

One way...assumes two worksheet workbook - will need to modify

Dim rngFind as Range

Set rngFind = ActiveWorkbook.Sheets(2).Range("D5"))

ActiveCell.Replace What:=rngFind, Replacement:=" ", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

If the "what" above requires a string (I can't remember off the top of my head), you will need to declare a string variable and assign the converted D5 range reference via CStr (if D5 is not a string already...tough to tell without source wb).

**Vlad717** · 03-08-2013, 01:27 PM

Thanks for the reply AlvaroSiza. The code you had before you edited actually worked great

I realized though that it created a few other problems in what I was trying to accomplish though. It could only search one cell at a time, and each cell would have to be written out separately. It also would require additional scripting to prevent it from running on empty cells if the user never put in a value.

I should elaborate that the input side might have 1 serial number, or it might have 100 depending on how many parts are being pulled. Currently I tried takign your code and duplicating it with a IF statement to prevent it running on empty cells, but that is about 15 lines per cell and has to be manually adjusted to run on the next cell. I don't think doing that 150 times is the smart way to do it as I am just asking for something to break along the way.

I've attached an example of what I am trying to explain. It might clarify it substantially.

Thanks

excel example - removing value from sheet.xlsx

**AlvaroSiza** · 03-08-2013, 03:16 PM

In a standard Module within the example workbook you provided, please paste the code, execute, and report back results.

Option Explicit

Sub PartNo()

Dim wb              As Workbook
Dim ws1             As Worksheet
Dim ws2             As Worksheet
Dim rngCell         As Range
Dim rngSource       As Range
Dim rngTarget       As Range
Dim rngFind         As Range

Set wb = ActiveWorkbook
Set ws1 = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("Sheet2")


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
        With ws1
            Set rngSource = .Range("A3", .Range("A66523").End(xlUp))
        End With
        
        For Each rngCell In rngSource
            If Not rngCell = "" Then
                With ws2.Range("A:A")
                    Set rngFind = .Find(rngCell, .Cells(.Cells.Count), _
                                        LookIn:=xlValues, _
                                        LookAt:=xlWhole, _
                                        SearchOrder:=xlByRows, _
                                        SearchDirection:=xlNext, _
                                        MatchCase:=False)
                    If Not rngFind Is Nothing Then
                        rngFind.ClearContents
                    End If
                End With
            End If
        Next
        
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub

**Vlad717** · 03-08-2013, 03:58 PM

That works better then perfect! There is no flashing between sheets and all the stuff I had in there before. Its clean and quick. It's fantastic, thank you!