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