VBA to Find and Replace into different column, same row

G

geigMR

Board Regular
Joined
Sep 27, 2011
Messages
51
Hello

I'm really struggling on this... I have a column with 000s of entries and I'd like to use vba to search the column for some text, and if found replace a different cell in a different column but the same row. The searched for text is a fixed list of approx. dozen items, and it will always be found at the beginning of the column, and only once in the entire column. So if Sheet2-A9 is found in cell Sheet1-B8950 then Sheet2-B9 replaces the contents of Sheet1-A8950. Sheet1-Column A has existing formulas so the macro will be overwriting its contents.

I'm completely new to VBA but have tried to adapt:
Excel: Find and Replace VBA, target cell, parent cells
http://www.mrexcel.com/forum/excel-questions/600081-macro-find-replace-offset.html
but can't get them working.

Please see my example:
sheet1:
Sheet1[TABLE="class: html-maker-worksheet"]
<thead>[TR]
[TH][/TH]
[TH]A[/TH]
[TH]B[/TH]
[/TR]
</thead><tbody>[TR]
[TH]1[/TH]
[TD]4PCE[/TD]
[TD]4PCE MOND/G/SET-RS FLORAL LARGE & SMALL POT # 114.75 [/TD]
[/TR]
[TR]
[TH]2[/TH]
[TD]4PCE[/TD]
[TD]4PCE MOND/G/SET-RR FLORAL LARGE & SMALL POT # 240.75 [/TD]
[/TR]
[TR]
[TH]3[/TH]
[TD]test1[/TD]
[TD]test1 test[/TD]
[/TR]
[TR]
[TH]4[/TH]
[TD]test2[/TD]
[TD]test2 test[/TD]
[/TR]
[TR]
[TH]5[/TH]
[TD]5PCE[/TD]
[TD]5PCE POND/G/SET-RS FLORAL LARGE & MED POT # 118.75 [/TD]
[/TR]
[TR]
[TH]6[/TH]
[TD]5PCE[/TD]
[TD]5PCE POND/G/SET-RR FLORAL LARGE & MED POT # 248.95 [/TD]
[/TR]
[TR]
[TH]7[/TH]
[TD]COMBS01/SET-RS[/TD]
[TD]COMBS01/SET-RS PLAIN MEN'S COMBS & TIE # 59.25 [/TD]
[/TR]
[TR]
[TH]8[/TH]
[TD]COMBS02/SET-RS[/TD]
[TD]COMBS02/SET-RS DETAIL MEN'S COMBS & TIE # 59.25 [/TD]
[/TR]
[TR]
[TH]9[/TH]
[TD]FB2-RR-BLA[/TD]
[TD]FB2-RR-BLA CANDLE STICK - KEY # 33.25 [/TD]
[/TR]
[TR]
[TH]10[/TH]
[TD]test3[/TD]
[TD]test3 test[/TD]
[/TR]
[TR]
[TH]11[/TH]
[TD]FB5*PIP-RR-CRE[/TD]
[TD]FB5*PIP-RR-CRE CANDLE STICK - CREAM - KEY - PIP BOX # 41.5 [/TD]
[/TR]
[TR]
[TH]12[/TH]
[TD]test4[/TD]
[TD]test4 test[/TD]
[/TR]
[TR]
[TH]13[/TH]
[TD]test5[/TD]
[TD]test5 test[/TD]
[/TR]
[TR]
[TH]14[/TH]
[TD]test6[/TD]
[TD]test6 test[/TD]
[/TR]
[TR]
[TH]15[/TH]
[TD]MS1-RR-BLUE[/TD]
[TD]MS1-RR-BLUE NEW MODEL-BLUE-KEY # 16.25 [/TD]
[/TR]
[TR]
[TH]16[/TH]
[TD]test7[/TD]
[TD]test7 test[/TD]
[/TR]
[TR]
[TH]17[/TH]
[TD]test8[/TD]
[TD]test8 test[/TD]
[/TR]
[TR]
[TH]18[/TH]
[TD]MS1/U-RR-BLUE[/TD]
[TD]MS1/U-RR-BLUE NEW MODEL-BLUE-KEY # 16.25 [/TD]
[/TR]
[TR]
[TH]19[/TH]
[TD]test9[/TD]
[TD]test9 test[/TD]
[/TR]
[TR]
[TH]20[/TH]
[TD]SMALL[/TD]
[TD]SMALL MOND/G-RS FLORAL SMALL POT # 58.5 [/TD]
[/TR]
[TR]
[TH]21[/TH]
[TD]SMALL[/TD]
[TD]SMALL POND/G-RS FLORAL SMALL POT # 72.3 [/TD]
[/TR]
</tbody>[/TABLE]
Excel 2003

CellFormula
A1=LEFT(B1,FIND(" ",B1)-1)
A2=LEFT(B2,FIND(" ",B2)-1)
A3=LEFT(B3,FIND(" ",B3)-1)
A4=LEFT(B4,FIND(" ",B4)-1)
A5=LEFT(B5,FIND(" ",B5)-1)
A6=LEFT(B6,FIND(" ",B6)-1)
A7=LEFT(B7,FIND(" ",B7)-1)
A8=LEFT(B8,FIND(" ",B8)-1)
A9=LEFT(B9,FIND(" ",B9)-1)
A10=LEFT(B10,FIND(" ",B10)-1)
A11=LEFT(B11,FIND(" ",B11)-1)
A12=LEFT(B12,FIND(" ",B12)-1)
A13=LEFT(B13,FIND(" ",B13)-1)
A14=LEFT(B14,FIND(" ",B14)-1)
A15=LEFT(B15,FIND(" ",B15)-1)
A16=LEFT(B16,FIND(" ",B16)-1)
A17=LEFT(B17,FIND(" ",B17)-1)
A18=LEFT(B18,FIND(" ",B18)-1)
A19=LEFT(B19,FIND(" ",B19)-1)
A20=LEFT(B20,FIND(" ",B20)-1)
A21=LEFT(B21,FIND(" ",B21)-1)

<tbody>
[TD="bgcolor: #FFFFFF"] Worksheet Formulas [TABLE="class: html-maker-worksheet"]
<thead>[TR]

</thead><tbody>
</tbody>
[/TD]
[/TR]
</tbody>[/TABLE]



sheet 2:
Sheet2[TABLE="class: html-maker-worksheet"]
<thead>[TR]
[TH][/TH]
[TH]A[/TH]
[TH]B[/TH]
[/TR]
</thead><tbody>[TR]
[TH]1[/TH]
[TD]4PCE MOND/G/SET-RS[/TD]
[TD]4PCE MOND/G/SET-RS[/TD]
[/TR]
[TR]
[TH]2[/TH]
[TD]4PCE MOND/G/SET-RR[/TD]
[TD]4PCE MOND/G/SET-RR[/TD]
[/TR]
[TR]
[TH]3[/TH]
[TD]5PCE POND/G/SET-RS[/TD]
[TD]5PCCPONDGSET-RS[/TD]
[/TR]
[TR]
[TH]4[/TH]
[TD]5PCE POND/G/SET-RR[/TD]
[TD]5PCEPONDGSET-RR[/TD]
[/TR]
[TR]
[TH]5[/TH]
[TD]COMBS01/SET-RS[/TD]
[TD]COMBS01/SET-RS[/TD]
[/TR]
[TR]
[TH]6[/TH]
[TD]COMBS02/SET-RS[/TD]
[TD]COMBS02SET-RS[/TD]
[/TR]
[TR]
[TH]7[/TH]
[TD]FB2-RR-BLA[/TD]
[TD]FB2-RR-BLA[/TD]
[/TR]
[TR]
[TH]8[/TH]
[TD]FB5*PIP-RR-CRE[/TD]
[TD]FB5*PIP-RR-CRE[/TD]
[/TR]
[TR]
[TH]9[/TH]
[TD]FB5-RR-BLA[/TD]
[TD]FB5-RR-BLA[/TD]
[/TR]
[TR]
[TH]10[/TH]
[TD]MS1-RR-BLUE[/TD]
[TD]MS1-RR-BLUE[/TD]
[/TR]
[TR]
[TH]11[/TH]
[TD]MS1/U-RR-BLUE[/TD]
[TD]MS1/U-RR-BLUE[/TD]
[/TR]
[TR]
[TH]12[/TH]
[TD]SMALL MOND/G-RS[/TD]
[TD]SMALL MOND/G-RS[/TD]
[/TR]
[TR]
[TH]13[/TH]
[TD]SMALL POND/G-RS[/TD]
[TD]SMALPONDG-RS[/TD]
[/TR]
</tbody>[/TABLE]
Excel 2003



Hugely grateful for any enlightenment on this!!!
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
Try something like this...

Code: 
[color=darkblue]Sub[/color] Replace_From_List()
    
    [color=darkblue]Dim[/color] cell [color=darkblue]As[/color] Range, rngFind [color=darkblue]As[/color] Range, counter [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=green]'List of items to search for from Sheet2 column A[/color]
    [color=darkblue]With[/color] Sheets("Sheet2")
        [color=darkblue]Set[/color] rngFind = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] cell [color=darkblue]In[/color] rngFind
        [color=green]'Search in Sheet1 Column B[/color]
        [color=darkblue]Set[/color] Found = Sheets("Sheet1").Range("B:B").Find(What:=cell.Value, _
                                                       LookIn:=xlValues, _
                                                       LookAt:=xlPart, _
                                                       MatchCase:=False)
                                                       
        [color=darkblue]If[/color] [color=darkblue]Not[/color] Found [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
            [color=green]'When a match is found, replace Sheet1 column A with Sheet2 Column B[/color]
            [color=green]'Overwrites formulas[/color]
            Found.Offset(, -1).Value = cell.Offset(, 1).Value
            counter = counter + 1
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] cell
    
    MsgBox "Replacements made: " & counter, , "Replacements Complete"
    
End [color=darkblue]Sub[/color]
 
Upvote 0
Since there should be only one occurence of the item in the searched range, the Find method should locate the item without a lot of looping. I do note, however, that the type of data being seached seems to be subject to multiple input errors in format and case. That is, Some might capitalize and others not, or some might use different abbreviations, etc. Those would have bearing on the success of a good search. This was only tested to see if it would run without error, and it did.

Code:
Sub fndNreplc()
Dim sh1 As Worksheet, sh2 As Worksheet, rng1 As Range, lr1 As Long, rng2 As Range
Set sh1 = Sheets(1)
Set sh2 = Sheets(2)
lr1 = sh1.Cells(Rows.Count, 2).End(xlUp).Row
Set rng1 = sh1.Range("B1:B" & lr1)
Set rng2 = sh2.Range("A1:A12") 'Adjust to actual source range
For Each c In rng2
If c <> "" Then
Set srch = rng1.Find(c.Value, LookIn:=xlValues)
If Not srch Is Nothing Then
srch.Offset(0, -1) = c.Offset(0, 1)
End If
End If
Next
End Sub
Code:
 
Upvote 0
WOW, thank you soooooooooo much AlphaFrog, that's amazing!!!!! :beerchug: I was starting to lose the will on this, you are so kind to help me. Thanks also to JLGWhiz for your response. This forum restores one's faith in humanity! :)

AlphaFrog, your macro works perfectly, and fast too on my large spreadsheet.

One thing I've been trying to work out is how I can identify and filter the changed cells. At the moment I have a column K in sheet1 into which I manually type "SPECIAL CODE" for each item that has been overwritten in column A of the same row, which I can then easily filter. I'd like to keep this column, but this manual approach is difficult with a long, continually changing list. I can use Ctrl+g > Special > Constants to highlight the items changed by your macro, but can't filter such cells.

Is there a way to modify your macro so that for each cell changed in Sheet1 column A (or cell found in Sheet1 Column B), "SPECIAL CODE" is added to column K (same row)?

That would be a real bonus. Thanks very much for any further help if poss.
 
Upvote 0
You're welcome and thanks for the feedback.

Code: 
[COLOR=darkblue]Sub[/COLOR] Replace_From_List()
    
    [COLOR=darkblue]Dim[/COLOR] cell [COLOR=darkblue]As[/COLOR] Range, rngFind [COLOR=darkblue]As[/COLOR] Range, Found [COLOR=darkblue]As[/COLOR] Range, counter [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=green]'List of items to search for from Sheet2 column A[/COLOR]
    [COLOR=darkblue]With[/COLOR] Sheets("Sheet2")
        [COLOR=darkblue]Set[/COLOR] rngFind = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] cell [COLOR=darkblue]In[/COLOR] rngFind
        [COLOR=green]'Search in Sheet1 Column B[/COLOR]
        [COLOR=darkblue]Set[/COLOR] Found = Sheets("Sheet1").Range("B:B").Find(What:=cell.Value, _
                                                       LookIn:=xlValues, _
                                                       LookAt:=xlPart, _
                                                       MatchCase:=False)
                                                       
        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Found [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
            [COLOR=green]'When a match is found, replace Sheet1 column A with Sheet2 Column B[/COLOR]
            [COLOR=green]'Overwrites formulas[/COLOR]
            Found.Offset(, -1).Value = cell.Offset(, 1).Value  [COLOR=green]'Value in Column A[/COLOR]
            [COLOR=#ff0000]Found.Offset(, 9).Value = "SPECIAL CODE"[/COLOR]           [COLOR=green]'Label in Column K[/COLOR]
            counter = counter + 1
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] cell
    
    MsgBox "Replacements made: " & counter, , "Replacements Complete"
    
End [COLOR=darkblue]Sub[/COLOR]
 
Last edited:
Upvote 0
geigMR said:
AlphaFrog, you're a star. Tested out and works brilliantly. I'm in awe :bow:

Thank you
Click to expand...

Hi,

I wanna say this is a great forum! I have tried the code above but it does not work quite right for me.
I have 22 sheets and i need to add text to column a depending on what it finds in column B. this for autparts so I have in column b something like"1999-2000 Auto parts for Dodge Ram truck" im concerned just with finding dodge in the string and when I find that I want to put dodge in column a so I can sort by Make easier. I read the makes off of sheet1 to compare with column B. The code example above runs but it leaves column a empty and doesnt find all the makes. In column b on all the sheets I have different amounts of rows up to about 1000. Im thinking maybe the find is trying to find exact match or something. im not really sure. Any help would be appreciated.
I am using excel 2013 if that makes any difference.
 
Upvote 0
Alpha Frog

I figured out that I was pulling data from the wrong column, so I got that one figured out. The only problem I have now is looping through each item in column B sheet 1. It will find the make of vehicle as it is from the data in sheet 2 but only one occurrence.

Here is a sample of my sheet 1 Data after I ran the code some sheets I have much more data. I think i need a inner loop to iterate through each column b item?
I tried a couple of different things but got the same results. Below I have posted sample data and code I modified. I'm not quite sure how I need to loop through the column b sheet 1 data any help would be greatly appreciated. Im a newbie with VBA and im learning I hope to be as good as the people on this site someday.
[TABLE="width: 491"]
<tbody>[TR]
[TD][/TD]
[TD]03-04 MITSUBISHI MONTERO Auto Parts
[/TD]
[/TR]
[TR]
[TD]JEEP[/TD]
[TD]05-07 JEEP GRAND CHEROKEE Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]05-07 JEEP GRAND CHEROKEE Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]05-07 JEEP GRAND CHEROKEE Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1991 1992 CHEVY TRUCK C/K Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1991 1992 CHEVY TRUCK C/K Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1991 1992 CHEVY TRUCK C/K Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1991 1992 CHEVY TRUCK C/K Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1991 1992 CHEVY TRUCK C/K Auto Parts[/TD]
[/TR]
[TR]
[TD]MITSUBISHI[/TD]
[TD]1999 MITSUBISHI GALANT Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1999-2004 CHEVY TRACKER Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1999-2004 CHEVY TRACKER Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1999-2004 CHEVY TRACKER Auto Parts[/TD]
[/TR]
[TR]
[TD]TOYOTA[/TD]
[TD]2000-2003 TOYOTA ECHO Auto Parts[/TD]
[/TR]
[TR]
[TD]DODGE[/TD]
[TD]2002 DODGE RAM 5.2L Auto Parts[/TD]
[/TR]
[TR]
[TD]HONDA[/TD]
[TD]2002-2006 HONDA CRV CR-V Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2002-2006 HONDA CRV CR-V Auto Parts[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2002-2006 HONDA CRV CR-V Auto Parts[/TD]
[/TR]
</tbody>[/TABLE]
Here is a sample of my sheet 2 data
[TABLE="width: 388"]
<tbody>[TR]
[TD]ACURA		ACURA
ALFA ROMEOALFA ROMEO
AMERICAN MOTORSAMERICAN MOTORS
AUDIAUDI
BMWBMW
BUICKBUICK
CADILLACCADILLAC
CHEVROLETCHEVROLET
CHRYSLERCHRYSLER
DAEWOODAEWOO
DODGEDODGE
EAGLEEAGLE
FORDFORD
GEOGEO
GMCGMC
HONDAHONDA

<tbody>
</tbody>
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]And the code I tried to loop through each item in sheet1 columnb
Code: 
Sub Replace_From_List()
    
    Dim cell As Range, rngFind As Range, counter As Long, rangFind2 As Range, cell2 As Range, counter2 As Long
       
    
    'List of items to search for from Sheet2 column A
    With Sheets("Sheet2")
        Set rngFind = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With
    With Sheets("Sheet1")
        Set rangFind2 = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
    End With
    For Each cell In rngFind
        'Search in Sheet1 Column B
       For Each cell2 In rangFind2 'Search in column B Sheet 1
        Set Found = Sheets("Sheet1").Range("B:B").Find(What:=cell.Value, _
                                                       LookIn:=xlValues, _
                                                       LookAt:=xlPart, _
                                                       MatchCase:=False)
                                                       
        If Not Found Is Nothing Then
            'When a match is found, replace Sheet1 column A with Sheet2 Column B
            'Overwrites formulas
            Found.Offset(, -1).Value = cell.Offset(, 1).Value
            counter = counter + 1
       
        End If
            counter2 = couter2 + 1
        Next cell2
    Next cell

    MsgBox "Replacements made: " & counter, , "Replacements Complete"
    
End Sub
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
VBA Find match, if found, copy rows and paste in different workbook
Replies
6
Views
481
MARK858
MARK858
P
  • Question Question
VBA for sending rows of data if column A = current date. (Via email)
Replies
1
Views
732
paun_shotts
P
P
  • Question Question
find unique values in a workbook and replace their rows with the same rows values from another workbook
Replies
0
Views
683
ProT
P
K
  • Question Question
Search One Column of Worksheet for multiple different partial texts, and if found post a respective value in the same row, one column further
Replies
1
Views
840
karp1
K
N
  • Solved
Separate One Cell Data into Multiple Rows
Replies
6
Views
1K
Fluff
Fluff

Forum statistics

Threads
1,223,896
Messages
6,175,265
Members
452,627
Latest member
KitkatToby

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