A Nme occurs only once in sheet Input column A.

A Nme can occur multiple times in the list on sheet Output, need to return the Resize(1, 41) for each Nme back to sheet Input. (Repeated Nme's have different data in their rows)

Some Nme's in Input sheet do not occur on the other sheet.

This code returns the first Nme's resized row back to Nme.(Offfset(,1).

So the revised code should probably return Nme & Resized row to column C of Input.

Thanks,
Howard

Sub Nme_Find()
Dim rngFound As Range
Dim Nme As Range
Dim OneRng As Range

Set OneRng = Sheets("Input").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)

For Each Nme In OneRng
Set rngFound = Sheets("Output").Range("A:A").Find(What:=Nme, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rngFound Is Nothing Then
rngFound.Offset(, 1).Resize(1, 41).Copy Nme.Offset(, 1)
End If
Next
End Sub

Hi Howard,

Am Wed, 24 Jun 2015 22:55:13 -0700 (PDT) schrieb L. Howard:

A Nme occurs only once in sheet Input column A.

A Nme can occur multiple times in the list on sheet Output, need to return the Resize(1, 41) for each Nme back to sheet Input. (Repeated Nme's have different data in their rows)

if Nme is only once in sheet Input but can occur more than once in
Output where should the data go?
If you overwrite the existing data you get only the last match.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Thu, 25 Jun 2015 08:10:10 +0200 schrieb Claus Busch:

if Nme is only once in sheet Input but can occur more than once in
Output where should the data go?
If you overwrite the existing data you get only the last match.

try it this way. If Nme is found more than once new rows are created in
Input. After running the macro you can sort Input to put the same Nme
together:

Sub Nme_Find()
Dim rngFound As Range
Dim Nme As Range
Dim OneRng As Range
Dim FirstAddress As String

Set OneRng = Sheets("Input").Range("A2:A" & Cells(Rows.Count,
"A").End(xlUp).Row)

For Each Nme In OneRng
Set rngFound = Sheets("Output").Range("A:A").Find(What:=Nme.Value , _
LookIn:=xlValues, _
LookAt:=xlWhole)

If Not rngFound Is Nothing Then
FirstAddress = rngFound.Address
Do
If Application.CountA(Nme.Offset(, 1).Resize(1, 41)) = 0 Then
rngFound.Offset(, 1).Resize(1, 41).Copy Nme.Offset(, 1)
Else
rngFound.Resize(1, 41).Copy _
Sheets("Input").Cells(Rows.Count, 1).End(xlUp)(2)
End If
Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress
End If
Next
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi again,

Am Thu, 25 Jun 2015 08:31:42 +0200 schrieb Claus Busch:

If Application.CountA(Nme.Offset(, 1).Resize(1, 41)) = 0 Then
rngFound.Offset(, 1).Resize(1, 41).Copy Nme.Offset(, 1)
Else
rngFound.Resize(1, 41).Copy _
Sheets("Input").Cells(Rows.Count, 1).End(xlUp)(2)
End If

sorry typo. Change the above to:

If Application.CountA(Nme.Offset(, 1).Resize(1, 41)) = 0 Then
rngFound.Offset(, 1).Resize(1, 41).Copy Nme.Offset(, 1)
Else
rngFound.Resize(1, 42).Copy _
Sheets("Input").Cells(Rows.Count, 1).End(xlUp)(2)
End If


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Thu, 25 Jun 2015 08:38:15 +0200 schrieb Claus Busch:

If Application.CountA(Nme.Offset(, 1).Resize(1, 41)) = 0 Then
rngFound.Offset(, 1).Resize(1, 41).Copy Nme.Offset(, 1)
Else
rngFound.Resize(1, 42).Copy _
Sheets("Input").Cells(Rows.Count, 1).End(xlUp)(2)
End If

better and faster without copying:

Sub Nme_Find()
Dim rngFound As Range
Dim Nme As Range
Dim OneRng As Range
Dim FirstAddress As String

Set OneRng = Sheets("Input").Range("A2:A" & Cells(Rows.Count,
"A").End(xlUp).Row)

Application.ScreenUpdating = False
For Each Nme In OneRng
Set rngFound = Sheets("Output").Range("A:A").Find(What:=Nme.Value , _
LookIn:=xlValues, _
LookAt:=xlWhole)

If Not rngFound Is Nothing Then
FirstAddress = rngFound.Address
Do
If Application.CountA(Nme.Offset(, 1).Resize(1, 41)) = 0
Then
Nme.Offset(, 1).Resize(1, 41).Value = _
rngFound.Offset(, 1).Resize(1, 41).Value
Else
Sheets("Input").Cells(Rows.Count, 1).End(xlUp)(2). _
Resize(1, 42).Value = rngFound.Resize(1, 42).Value
End If
Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress
End If
Next
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

better and faster without copying:

Sub Nme_Find()
Dim rngFound As Range
Dim Nme As Range
Dim OneRng As Range
Dim FirstAddress As String

Set OneRng = Sheets("Input").Range("A2:A" & Cells(Rows.Count,
"A").End(xlUp).Row)

Application.ScreenUpdating = False
For Each Nme In OneRng
Set rngFound = Sheets("Output").Range("A:A").Find(What:=Nme.Value , _
LookIn:=xlValues, _
LookAt:=xlWhole)

If Not rngFound Is Nothing Then
FirstAddress = rngFound.Address
Do
If Application.CountA(Nme.Offset(, 1).Resize(1, 41)) = 0
Then
Nme.Offset(, 1).Resize(1, 41).Value = _
rngFound.Offset(, 1).Resize(1, 41).Value
Else
Sheets("Input").Cells(Rows.Count, 1).End(xlUp)(2). _
Resize(1, 42).Value = rngFound.Resize(1, 42).Value
End If
Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress
End If
Next
Application.ScreenUpdating = True
End Sub


Hi Claus,

I am thinking this does what I want, but over writes old list on Output.

I changed this line to list in column C but the first entry is in B and the rest are in C.

Sheets("Input").Cells(Rows.Count, 2).End(xlUp)(2). _
Resize(1, 42).Value = rngFound.Resize(1, 42).Value

Can't find what is making first return in B and others in C.

Maybe I'm screwed up, I'll keep checking on it.

Howard

On Thursday, June 25, 2015 at 12:36:57 AM UTC-7, L. Howard wrote:
better and faster without copying:

Sub Nme_Find()
Dim rngFound As Range
Dim Nme As Range
Dim OneRng As Range
Dim FirstAddress As String

Set OneRng = Sheets("Input").Range("A2:A" & Cells(Rows.Count,
"A").End(xlUp).Row)

Application.ScreenUpdating = False
For Each Nme In OneRng
Set rngFound = Sheets("Output").Range("A:A").Find(What:=Nme.Value , _
LookIn:=xlValues, _
LookAt:=xlWhole)

If Not rngFound Is Nothing Then
FirstAddress = rngFound.Address
Do
If Application.CountA(Nme.Offset(, 1).Resize(1, 41)) = 0
Then
Nme.Offset(, 1).Resize(1, 41).Value = _
rngFound.Offset(, 1).Resize(1, 41).Value
Else
Sheets("Input").Cells(Rows.Count, 1).End(xlUp)(2). _
Resize(1, 42).Value = rngFound.Resize(1, 42).Value
End If
Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress
End If
Next
Application.ScreenUpdating = True
End Sub


Hi Claus,

I am thinking this does what I want, but over writes old list on Output.

I changed this line to list in column C but the first entry is in B and the rest are in C.

Sheets("Input").Cells(Rows.Count, 2).End(xlUp)(2). _
Resize(1, 42).Value = rngFound.Resize(1, 42).Value

Can't find what is making first return in B and others in C.

Maybe I'm screwed up, I'll keep checking on it.

Howard

Typo Sheets("Input").Cells(Rows.Count, 2).End(xlUp)(2).

should be Sheets("Input").Cells(Rows.Count, 3).End(xlUp)(2).

Howard

Hi Howard,

Am Thu, 25 Jun 2015 00:39:51 -0700 (PDT) schrieb L. Howard:

Typo Sheets("Input").Cells(Rows.Count, 2).End(xlUp)(2).

should be Sheets("Input").Cells(Rows.Count, 3).End(xlUp)(2).

sorry I don't understand.
Why do you want to bring the data ometimers to column A and sometimes to
C?
Can you show me the layout of the tables and the expected result if a
Nme occurs more than once?


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

sorry I don't understand.
Why do you want to bring the data ometimers to column A and sometimes to
C?
Can you show me the layout of the tables and the expected result if a
Nme occurs more than once?

Sure, I believe this will show it.

Actually I am open to how the data comes back to Input, But I want to keep original Input sheet column A intact and list the results in column C.

I suspect there will need to be a sort to group the same Nme's together. My example has numbers but the real data will most likely be just words.

I limited rows of data but there will be about 41+- on Output.

Sheet Input column A

Header
input-1
input-2
input-3
input-4
input-6
input-8
input-10
input-11
input-12
input-13

Sheet Output Col A - D (40+- more rows)

Header
input-1 data 1 and More cells
input-2 data 2 and More cells
input-3 data 3 and More cells
input-1 data 4 and More cells
input-5 data 5 and More cells
input-6 data 6 and More cells
input-7 data 7 and More cells
input-8 data 8 and More cells
input-9 data 9 and More cells
input-10 data 10 and More cells
input-11 data 11 and More cells
input-8 data 12 and More cells
input-13 data 13 and More cells
input-13 data 14 and More cells

Sheet Input results

Header
input-1 input-1 data 1 and More cells
input-2 input-1 data 4 and More cells
input-3 input-2 data 2 and More cells
input-4 input-3 data 3 and More cells
input-6 input-6 data 6 and More cells
input-8 input-8 data 8 and More cells
input-10 input-8 data 12 and More cells
input-11 input-10 data 10 and More cells
input-12 input-11 data 11 and More cells
input-13 input-13 data 13 and More cells
input-13 data 14 and More cells


Hope the format hold together.

My Drop Box is down with some sort of problem.

Howard

My Drop Box is down with some sort of problem.

Howard

Ahaa! Drop Box working now.

https://www.dropbox.com/s/jyawocfar9...Copy.xlsm?dl=0

This might be better.

Howard

Hi Howard,

Am Thu, 25 Jun 2015 02:27:26 -0700 (PDT) schrieb L. Howard:

https://www.dropbox.com/s/jyawocfar9...Copy.xlsm?dl=0

that is easier to handle.
Try:

Sub Nme_Find_Exp()
Dim rngFound As Range, Nme As Range
Dim OneRng As Range, rngBig As Range
Dim FirstAddress As String

Set OneRng = Sheets("Input").Range("A2:A" & Cells(Rows.Count,
"A").End(xlUp).Row)

For Each Nme In OneRng

Set rngFound = Sheets("Output").Range("A:A").Find(What:=Nme.Value , _
LookIn:=xlValues, _
LookAt:=xlWhole)


If Not rngFound Is Nothing Then

FirstAddress = rngFound.Address
Do
If rngBig Is Nothing Then
Set rngBig = rngFound.Resize(1, 42)
Else
Set rngBig = Union(rngBig, rngFound.Resize(1, 42))
End If
Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress

End If
Next
Sheets("Input").Range("C2").Resize(rngBig.Rows.Cou nt, 42).Value =
rngBig.Value
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Thu, 25 Jun 2015 02:27:26 -0700 (PDT) schrieb L. Howard:

https://www.dropbox.com/s/jyawocfar9...Copy.xlsm?dl=0

ignore the last answer and try it this way:

Sub Nme_Find_Exp()
Dim rngFound As Range, Nme As Range
Dim OneRng As Range, rngBig As Range
Dim FirstAddress As String

Set OneRng = Sheets("Input").Range("A2:A" & Cells(Rows.Count,
"A").End(xlUp).Row)

For Each Nme In OneRng

Set rngFound = Sheets("Output").Range("A:A").Find(What:=Nme.Value , _
LookIn:=xlValues, _
LookAt:=xlWhole)


If Not rngFound Is Nothing Then

FirstAddress = rngFound.Address
Do
Sheets("Input").Cells(Rows.Count, 3).End(xlUp)(2) _
.Resize(1, 42).Value = rngFound.Resize(1, 42).Value
Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress

End If
Next
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

ignore the last answer and try it this way:

Sub Nme_Find_Exp()
Dim rngFound As Range, Nme As Range
Dim OneRng As Range, rngBig As Range
Dim FirstAddress As String

Set OneRng = Sheets("Input").Range("A2:A" & Cells(Rows.Count,
"A").End(xlUp).Row)

For Each Nme In OneRng

Set rngFound = Sheets("Output").Range("A:A").Find(What:=Nme.Value , _
LookIn:=xlValues, _
LookAt:=xlWhole)


If Not rngFound Is Nothing Then

FirstAddress = rngFound.Address
Do
Sheets("Input").Cells(Rows.Count, 3).End(xlUp)(2) _
.Resize(1, 42).Value = rngFound.Resize(1, 42).Value
Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress

End If
Next
End Sub


Regards
Claus B.


Indeed! Your usual magic again. Thanks much.

Howard

Hi Claus,

I was not fully advised of the results criteria.

Nme's CAN occur more than once in sheets Input, column A.

Also, if no match found on Output sheet, the "no match" is listed as a result with the resize data cells blank.

Yellow cells on Input sheet have no match on Output sheet and ARE listed in Column C returns.

My attempt to rewrite the code does zip!

Thanks.
Howard

https://www.dropbox.com/s/jyawocfar9...Copy.xlsm?dl=0

Hi Howard,

Am Thu, 25 Jun 2015 17:57:20 -0700 (PDT) schrieb L. Howard:

Nme's CAN occur more than once in sheets Input, column A.

Also, if no match found on Output sheet, the "no match" is listed as a result with the resize data cells blank.

Yellow cells on Input sheet have no match on Output sheet and ARE listed in Column C returns.

try (in a standard module):

Sub Nme_Find_Exp_New()
Dim rngFound As Range
Dim varTmp As Variant, varCheck As Variant
Dim myDic As Object, i As Long
Dim FirstAddress As String

varTmp = Sheets("Input").Range("A2:A" & Cells(Rows.Count,
"A").End(xlUp).Row)
Set myDic = CreateObject("Scripting.Dictionary")
For i = LBound(varTmp) To UBound(varTmp)
myDic(varTmp(i, 1)) = varTmp(i, 1)
Next
varCheck = myDic.items

For i = LBound(varCheck) To UBound(varCheck)

Set rngFound = Sheets("Output").Range("A:A").Find(What:=varCheck( i), _
LookIn:=xlValues, _
LookAt:=xlWhole)

If Not rngFound Is Nothing Then

FirstAddress = rngFound.Address
Do

Sheets("Input").Cells(Rows.Count, 3).End(xlUp)(2) _
.Resize(1, 42).Value = rngFound.Resize(1, 42).Value

Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress
Else
Sheets("Input").Cells(Rows.Count, 3).End(xlUp)(2) = varCheck(i)
Sheets("Input").Cells(Rows.Count, 3).End(xlUp).Offset(, 1) = "no
Match"
End If
Next

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

That sure does it alright.

Not sure how important it is to have all instances of a "no match" instead of a single one.

Plain thinking says, if one Nme does not match, the several won't match either.

Is there a simple way to count the number of times a Nme does not match and include that with the "no Match = 4" or the like.

If not, lets let it stand as is.

Thanks,
Howard

Hi Howard,

Am Fri, 26 Jun 2015 01:37:15 -0700 (PDT) schrieb L. Howard:

Not sure how important it is to have all instances of a "no match" instead of a single one.

You cannot run for each cell in the range("A2:A16"). You have to run
only for the first occurance of a value

scenario1:
Input-1 is once in "Input" and three times in "OutPut"
With FindNext you find all 3 matches
Without you only find the first occurance

Scenario2:
Input-1 is twice in "Input" and three times in "Output"
If you run Find with FindNext for each occurance you will get 6 matches,
3 original and 3 duplicates.
If you run without FindNext you find the first occurance twice.

If another result is expected the OP should change his table layout


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Friday, June 26, 2015 at 1:59:18 AM UTC-7, Claus Busch wrote:
Hi Howard,

Am Fri, 26 Jun 2015 01:37:15 -0700 (PDT) schrieb L. Howard:

Not sure how important it is to have all instances of a "no match" instead of a single one.

You cannot run for each cell in the range("A2:A16"). You have to run
only for the first occurance of a value

scenario1:
Input-1 is once in "Input" and three times in "OutPut"
With FindNext you find all 3 matches
Without you only find the first occurance

Scenario2:
Input-1 is twice in "Input" and three times in "Output"
If you run Find with FindNext for each occurance you will get 6 matches,
3 original and 3 duplicates.
If you run without FindNext you find the first occurance twice.

If another result is expected the OP should change his table layout


Regards
Claus B.


Gotcha, it shall be fine as is and I thank you again.

Howard