VBA to find/replace information from one sheet to another

[dominikapabis]

Hello,

I am looking for help on writing a VBA that will replace information in one sheet using a legend that is in another sheet.

I need two things to happen.
1. replace cells in column C in Sheet1 with data from column C in Sheet2 if column C in Sheet1 = column A in Sheet2.
2. also insert the adjacent cell (Item Number) that corresponds with the new description.

Here is a simple sample of the spreadsheet.

Sheet 1 BEFORE Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"]1
[/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]EQUIPMENT TYPE[/TD]
[TD="align: center"]ITEM NUMBER[/TD]
[TD="align: center"]DESCRIPTION[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]Actives [/TD]
[TD="align: center"][/TD]
[TD="align: center"]NC400[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]Full Spectrum EQ- Bank 1[/TD]
[TD="align: center"][/TD]
[TD="align: center"]T2&4 CS12
[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]T2&4 CS09[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]Full Spectrum EQ - Bank 2[/TD]
[TD="align: center"][/TD]
[TD="align: center"]T8 CS09
[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]T8 CS06[/TD]
[/TR]
</tbody>[/TABLE]


Sheet 2 (KEY)
[TABLE="width: 500"]
<tbody>[TR]
[TD]1
[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD="align: center"]Original Description[/TD]
[TD="align: center"]Item Number[/TD]
[TD="align: center"]New Description[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]

NC400​

[/TD]
[TD]5543
[/TD]
[TD]Full Features 2x2[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]

T2&4 CS12​

[/TD]
[TD]5568[/TD]
[TD]Cable Simulator 12db
[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]

T2&4 CS09​

[/TD]
[TD]9956[/TD]
[TD]Cable Simulator 9db
[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]

T8 CS09​

[/TD]
[TD]5547[/TD]
[TD]Return Path 9db[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]

T8 CS06​

[/TD]
[TD]6689[/TD]
[TD]Return Path 6db[/TD]
[/TR]
</tbody>[/TABLE]


Sheet 1 AFTER CODE:
[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"]1
[/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]EQUIPMENT TYPE[/TD]
[TD="align: center"]ITEM NUMBER[/TD]
[TD="align: center"]DESCRIPTION[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]Actives [/TD]
[TD="align: center"]5543[/TD]
[TD="align: center"]Full Features 2x2[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]Full Spectrum EQ- Bank 1[/TD]
[TD="align: center"]5568[/TD]
[TD="align: center"]Cable Simulator 12db[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"][/TD]
[TD="align: center"]9956
[/TD]
[TD="align: center"]Cable Simulator 9db[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]Full Spectrum EQ - Bank 2[/TD]
[TD="align: center"]5547[/TD]
[TD="align: center"]Return Path 9db[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"][/TD]
[TD="align: center"]6689[/TD]
[TD="align: center"]Return Path 6db[/TD]
[/TR]
</tbody>[/TABLE]


I know that I will have to use a series of loops, I would appreciate any help.

Thanks!`

 

[Akuini]

Hi, dominikapabis
You can try this

Sub TRY()
    Dim rr As Long
    Dim rs As Long
    Dim r As Range
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim aCell As Range
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Application.ScreenUpdating = False
    
    Set ws1 = Sheets("sheet1")
    Set ws2 = Sheets("sheet2")
    
    rr = ws1.Range("C" & Rows.count).End(xlUp).row
    rs = ws2.Range("A" & Rows.count).End(xlUp).row
 
    
    Set Rng1 = ws1.Range("C2:C" & rr)
    Set Rng2 = ws2.Range("A2:A" & rs)
    For Each r In Rng1
    
    Set aCell = Rng2.Find(What:=r, LookIn:=xlValues, _
                lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=True, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        r.Value = aCell.Offset(0, 2).Value
        r.Offset(0, -1).Value = aCell.Offset(0, 1).Value
            
    End If
    Next
    
    Application.ScreenUpdating = True

End Sub

 

[hiker95]

dominikapabis,

Welcome to the MrExcel forum.

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?


Here is another macro solution for you to consider.

Sample raw data worksheets:

Excel 2007
	A	B	C
1	Original Description	Item Number	New Description
2	NC400	5543	Full Features 2x2
3	T2&4 CS12	5568	Cable Simulator 12db
4	T2&4 CS09	9956	Cable Simulator 9db
5	T8 CS09	5547	Return Path 9db
6	T8 CS06	6689	Return Path 6db
7
Sheet2

Excel 2007
	A	B	C
1	EQUIPMENT TYPE	ITEM NUMBER	DESCRIPTION
2	Actives		NC400
3	Full Spectrum EQ- Bank 1		T2&4 CS12
4			T2&4 CS09
5	Full Spectrum EQ - Bank 2		T8 CS09
6			T8 CS06
7
Sheet1

And, after the macro:

Excel 2007
	A	B	C
1	EQUIPMENT TYPE	ITEM NUMBER	DESCRIPTION
2	Actives	5543	Full Features 2x2
3	Full Spectrum EQ- Bank 1	5568	Cable Simulator 12db
4		9956	Cable Simulator 9db
5	Full Spectrum EQ - Bank 2	5547	Return Path 9db
6		6689	Return Path 6db
7
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub dominikapabis()
' hiker95, 02/09/2016, ME920278
Dim w1 As Worksheet, w2 As Worksheet
Dim r As Range, a As Range
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
With w1
  For Each r In .Range("C2", .Range("C" & Rows.Count).End(xlUp))
    Set a = w2.Columns(1).Find(r.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      r.Value = w2.Cells(a.Row, 3).Value
      r.Offset(, -1).Value = w2.Cells(a.Row, 2).Value
    End If
  Next r
  .UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the dominikapabis macro.

 

[dominikapabis]

Thank you hiker95! that worked beautifully!!

 

[hiker95]

dominikapabis,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.