Find value one at a time in all possible location and paste value corresponding to the value..

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,130
Hello Message Board,

From very long duration, Come back again to post the query. I hope everyone do well. okk..

I have written my code in Workbook 3.

In Workbook 2 I have multiple row repeated data in column A. example of data..

table abc pqr xzy
qwe chair poi lkjhgfdd ert
bhg fgdtrs table kjl re wwww
poi lkj dfg sdf chair
dfg fan asd
fan iu opi

In Workbook 1 I have master data.

Column A.....Column B
Table...........Lamp
Chair...........Man
Fan.............Air



Now, my query is..

Based on book 1 value, it find the values in Col A of Work book 2. Once the record finds, it paste the corresponding value in Col B of Workbook 2.

Example,

"Table" (cell A2) copy. go to book 2. finds all the "Table" in Col A. and paste "Lamp" (cell B2) value in front of

"table abc pqr xzy"
"bhg fgdtrs table kjl re wwww".


I hope I have clear my question.

I have did my code, but it finds only one record. I'm unable to do for find value one at a time all and paste value one at a time.

Please help me to get the code please.
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,130
Sharing my code as well,

Public Function fnFindtext()


Workbooks("Book1").Activate
Dim CountRowBk1 As Integer
Dim k As Integer 'k for counting total worksheets


For k = 1 To Worksheets.Count
Worksheets.Item(k).Activate
If Worksheets.Item(k).Name <> "Sheet6" Then
Else
CountRowBk1 = Range("A" & Rows.Count).End(xlUp).Row

'opening another workbook
Workbooks.Open "C:\Users\PUTEKAR\Book2.xlsx"
Dim CountRowBk2 As Integer
Dim FndTxt As String
Dim txt As String

CountRowBk2 = 1

Do Until Cells(CountRowBk2, 1) = ""

FndTxt = Cells(CountRowBk2, 1).Value

Workbooks("Book1").Activate
Range(Cells(1, 1), Cells(CountRowBk1, 1)).Select
txt = Selection.Find(What:=FndTxt, After:=ActiveCell, LookIn:=xlFormulas, lookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row

Workbooks("Book2").Activate
Cells(CountRowBk2, 2).Select
Selection.Copy

Workbooks("Book1").Activate
Cells(txt, 2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'---
CountRowBk2 = CountRowBk2 + 1
Loop
Workbooks("Book2").Close
End If
Next k
End Function
 

ww4612

Well-known Member
Joined
Apr 24, 2014
Messages
515
do you have problem to copy and paste value only? if you do not need to paste any other things like format and hyperlink. you can out put the cell value into a variable before transfer it to another cell value. like this
Code:
dim a as string
a=sheets(1).cells(1,1).value
sheets(2).cells(1,1).value=a
if you want to transfer value from a range, you can output the array into a variant, like the following
Code:
dim v as variant
with sheets(1)
v=range(.cells(1,1),cells(10,10))
end with
with sheets(2)
range(.cells(2,1),cells(11,10))=v
end with
 
Last edited:

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,130
Hi,
Thank You for replying.

But honestly Im not getting what u trying to said. First of all, I am using 3 workbooks not worksheets.

Code lies in book3, complex data lies in book2 and master data lies in book1. copy book1 value and find it in book2. now in book2, it may be single record find or multiple. Whatever no of records find, it paste the value.



do you have problem to copy and paste value only? if you do not need to paste any other things like format and hyperlink. you can out put the cell value into a variable before transfer it to another cell value. like this
Code:
dim a as string
a=sheets(1).cells(1,1).value
sheets(2).cells(1,1).value=a
if you want to transfer value from a range, you can output the array into a variant, like the following
Code:
dim v as variant
with sheets(1)
v=range(.cells(1,1),cells(10,10))
end with
with sheets(2)
range(.cells(2,1),cells(11,10))=v
end with
 

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,130

ADVERTISEMENT

Ohkk...seems I'm unable to present you properly.

At least tell me someone, do we find multiple records in one line of code? - If yes,

Then, can we paste our copied value in all the cell which ever we finds?

Please.
 

ww4612

Well-known Member
Joined
Apr 24, 2014
Messages
515
transfer value in among sheets is same as transfer value among workbooks. the only different is that you have to put the code into a module if you cord must run among several workbooks.

give me sometime. i will try to rewrite the code.
based on your expression, what you need is like a cross workbook vlookup function. am i right?
 
Last edited:

ww4612

Well-known Member
Joined
Apr 24, 2014
Messages
515
Code:
Dim r As Integer, rg As Range, s As String, r1 As Integer
r = 1
With Workbooks("Book2").Sheets(1)
Do
    fndtxt = Workbooks("Book1").Sheets(1).Cells(r, 1).Value
        Set rg = Range(.Cells(1, 1), .Cells(CountRowBk1, 1)).Find(what:=fndtxt, lookAt:=xlWhole)
        If Not rg Is Nothing Then
            .Cells(rg.Row, 2).Value = Workbooks("Book1").Sheets(1).Cells(r, 2).Value
        End If
        r = r + 1
    
Loop Until .Cells(r, 1).Value = NullString
End With
i did not test this code yet. can this code solve your problem?
and remember to put the code into a module not a sheet.
sorry i just made a mistake. i have corrected it
 
Last edited:

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,130
Hi,
Slight change in code...and inserting my comment to get the right information.

Dim r As Integer, rg As Range, s As String, r1 As Integer

r = 1
Do
FndTxt = Workbooks("Book2").Sheets(1).Cells(r, 1).Value
With Workbooks("Book1").Sheets(7)
Set rg = Range(.Cells(1, 1), .Cells(CountRowBk1, 1)).Find(what:=FndTxt, lookAt:=xlPart)
If Not rg Is Nothing Then
With Workbooks("Book2").Sheets(1).Cells(r, 2).Select

'here I require if the value finds then, from book2 copy the value infront of r value and paste besides to book1. i.e. in Col B. (note, here there are multiple r values also. Then how did there we can paste the data.) because, this loop mooving to next r value. It should find another value in range "Cells(1, 1), .Cells(CountRowBk1, 1)" and find again if there exist, "FndTxt"

'--I believe I'm able to try to explain.


.Cells(rg.Row, 2).Value = rg.Value

End If
r = r + 1
End With
Loop Until Cells(r, 1).Value = "" 'NullString

Code:
Dim r As Integer, rg As Range, s As String, r1 As Integer
r = 1
With Workbooks("Book2").Sheets(1)
Do
    fndtxt = Workbooks("Book1").Sheets(1).Cells(r, 1).Value
        Set rg = Range(.Cells(1, 1), .Cells(CountRowBk1, 1)).Find(what:=fndtxt, lookAt:=xlWhole)
        If Not rg Is Nothing Then
            .Cells(rg.Row, 2).Value = Workbooks("Book1").Sheets(1).Cells(r, 2).Value
        End If
        r = r + 1
    
Loop Until .Cells(r, 1).Value = NullString
End With
i did not test this code yet. can this code solve your problem?
and remember to put the code into a module not a sheet.
sorry i just made a mistake. i have corrected it
 

Watch MrExcel Video

Forum statistics

Threads
1,122,464
Messages
5,596,288
Members
414,052
Latest member
Dual Showman

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