VBA Find text and copy value to the right of the cell

gubertu

Board Regular
Joined
May 24, 2015
Messages
129
Hi all,

I would like to know if there is a code to do the following:

I have one tab called "Data" with some financial information and then, I have another sheets where I place this information, for example sheet "A1" and "A2".

Could it be possible to have code, that look if the words of column A of tab "Data" are repeated in the rest of the WB, and then place the amount of column B of tab Data to the right where the word is?
For example, in tab A1, cell B2 and tab A2, cell B2.

Hope I explaned well myself.

Thanks in advance!!


1) Tab "Data"

AB
1TextData
2Buildings1.000
3Machinery2.000


2) Tab "A1"


AB
1TextData
2BuildingsPlace value 1.000
Etc...


2) Tab "A2"


AB
1TextData
2MachineryPlace value 2.000
Etc...
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,238
Try:
VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, rng As Range, srcWS As Worksheet, ws As Worksheet, fnd As Range
    Set srcWS = Sheets("Data")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In srcWS.Range("A2:A" & LastRow)
        For Each ws In Sheets
            If ws.Name <> "Data" Then
                Set fnd = ws.Range("A:A").Find(rng.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    fnd.Offset(, 1) = rng.Offset(, 1)
                End If
            End If
        Next ws
    Next rng
    Application.ScreenUpdating = True
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,470
Office Version
  1. 365
Platform
  1. Windows
Another option
VBA Code:
Sub gubertu()
   Dim Cl As Range
   Dim Ws As Worksheet
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   With Sheets("Data")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic(Cl.Value) = Cl.Offset(, 1).Value
      Next Cl
   End With
   For Each Ws In Worksheets
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Cl.Offset(, 1).Value = Dic(Cl.Value)
      Next Cl
   Next Ws
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,420
Messages
5,624,693
Members
416,041
Latest member
behnejm

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
Top