Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Please help!
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,069
Default Please help!
The following code pops up my msg box... meaning it doesn't find what I am
looking for. Any ideas why? Thanks for the help.

John


Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = Range("j7:j712")

Set rngFound = rngToSearch.Find(what:=Array(Range("d1").Value,
Range("d2").Value, Range("d3").Value, Range("d4").Value), LookIn:=xlValues,
lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Do
With Worksheets("vlookup")
Set DestCell = Range("a800").End(xlDown).Offset(1, 0)
End With
rngFound.EntireRow.Copy _
Destination:=DestCell
Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,119
Default Please help!
There are at least four issues with your code...

1. You need to specify the sheet that the range you are searching is on.
2. You can not find an array. If you try it will only look for (first or
last I don't remember which) one of the items.
3. Find is an infinite loop. You want to stop when you get back to the firts
hit.
4. When you find nest you need to specify to start looking after the itme
you just found.

More like this...

Sub test()
Call findstuff("This")
Call findstuff("That")
End Sub

Sub findstuff(ByVal StringToFind As String)
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngCurrent As Range
Dim rngFirst As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Range("A1", "D100")

Set rngCurrent = rngToSearch.Find(StringToFind)
If rngCurrent Is Nothing Then
MsgBox "Not found"
Else
Set rngFirst = rngCurrent
Do
MsgBox rngCurrent.Value & vbTab & rngCurrent.Address
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngCurrent.Address = rngFirst.Address
End If

End Sub

--
HTH...

Jim Thomlinson


"John" wrote:

The following code pops up my msg box... meaning it doesn't find what I am
looking for. Any ideas why? Thanks for the help.

John


Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = Range("j7:j712")

Set rngFound = rngToSearch.Find(what:=Array(Range("d1").Value,
Range("d2").Value, Range("d3").Value, Range("d4").Value), LookIn:=xlValues,
lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Do
With Worksheets("vlookup")
Set DestCell = Range("a800").End(xlDown).Offset(1, 0)
End With
rngFound.EntireRow.Copy _
Destination:=DestCell
Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,069
Default Please help!
Jim thanks for the help. I am still having some issues.
It still seems to be in and endless loop (and I have taken out the array
just for testing). It also seems to copy cells that are to the right of my
rngToSearch column... as if it is moving over from that column rather than
starting on "d" or "a" or whatever column I select.

Here is the code now.
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim rngFirst As Range
'Dim WhatToFind As Variant
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = Sheets("data").Range("j7:j712")

'WhatToFind = Array(Range("d1").Value, Range("d2").Value,
Range("d3").Value, Range("d4").Value)

Set rngFound = rngToSearch.Find(what:=Sheets("data").Range("d1"). Value,
LookIn:=xlValues, Lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Do
'With Worksheets("vlookup")
'Set DestCell =
Sheets("vlookup").Range("a65536").End(xlUp).Offset (0, 1)
'End With
Set rngFirst = rngFound
saddr = rngFound.Address
myrow = rngFound.Row
'rngFound.EntireRow.Copy
'Destination:=DestCell
Range("a" & myrow, "j" & myrow).Copy
Sheets("vlookup").Select
Range("a65536").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound Is Nothing Or rngFound.Address = rngFirst.Address
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub

"Jim Thomlinson" wrote:

There are at least four issues with your code...

1. You need to specify the sheet that the range you are searching is on.
2. You can not find an array. If you try it will only look for (first or
last I don't remember which) one of the items.
3. Find is an infinite loop. You want to stop when you get back to the firts
hit.
4. When you find nest you need to specify to start looking after the itme
you just found.

More like this...

Sub test()
Call findstuff("This")
Call findstuff("That")
End Sub

Sub findstuff(ByVal StringToFind As String)
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngCurrent As Range
Dim rngFirst As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Range("A1", "D100")

Set rngCurrent = rngToSearch.Find(StringToFind)
If rngCurrent Is Nothing Then
MsgBox "Not found"
Else
Set rngFirst = rngCurrent
Do
MsgBox rngCurrent.Value & vbTab & rngCurrent.Address
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngCurrent.Address = rngFirst.Address
End If

End Sub

--
HTH...

Jim Thomlinson


"John" wrote:

The following code pops up my msg box... meaning it doesn't find what I am
looking for. Any ideas why? Thanks for the help.

John


Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = Range("j7:j712")

Set rngFound = rngToSearch.Find(what:=Array(Range("d1").Value,
Range("d2").Value, Range("d3").Value, Range("d4").Value), LookIn:=xlValues,
lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Do
With Worksheets("vlookup")
Set DestCell = Range("a800").End(xlDown).Offset(1, 0)
End With
rngFound.EntireRow.Copy _
Destination:=DestCell
Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,119
Default Please help!
Give this a whirl...

Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim rngFirst As Range
'Dim WhatToFind As Variant
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = wks.Range("j7:j712") '***Changed

'WhatToFind = Array(Range("d1").Value, Range("d2").Value,
'Range("d3").Value, Range("d4").Value)

Set rngFound = rngToSearch.Find(what:=Sheets("data").Range("d1"). Value, _
LookIn:=xlValues, Lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Set rngFirst = rngFound '***Moved...
Do
'With Worksheets("vlookup")
'Set DestCell =
'Sheets("vlookup").Range("a65536").End(xlUp).Offse t(0, 1)
'End With

saddr = rngFound.Address
myrow = rngFound.Row
'rngFound.EntireRow.Copy
'Destination:=DestCell
Range("a" & myrow, "j" & myrow).Copy
Sheets("vlookup").Select
Range("a65536").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound Is Nothing Or rngFound.Address = rngFirst.Address
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub
--
HTH...

Jim Thomlinson


"John" wrote:

Jim thanks for the help. I am still having some issues.
It still seems to be in and endless loop (and I have taken out the array
just for testing). It also seems to copy cells that are to the right of my
rngToSearch column... as if it is moving over from that column rather than
starting on "d" or "a" or whatever column I select.

Here is the code now.
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim rngFirst As Range
'Dim WhatToFind As Variant
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = Sheets("data").Range("j7:j712")

'WhatToFind = Array(Range("d1").Value, Range("d2").Value,
Range("d3").Value, Range("d4").Value)

Set rngFound = rngToSearch.Find(what:=Sheets("data").Range("d1"). Value,
LookIn:=xlValues, Lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Do
'With Worksheets("vlookup")
'Set DestCell =
Sheets("vlookup").Range("a65536").End(xlUp).Offset (0, 1)
'End With
Set rngFirst = rngFound
saddr = rngFound.Address
myrow = rngFound.Row
'rngFound.EntireRow.Copy
'Destination:=DestCell
Range("a" & myrow, "j" & myrow).Copy
Sheets("vlookup").Select
Range("a65536").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound Is Nothing Or rngFound.Address = rngFirst.Address
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub

"Jim Thomlinson" wrote:

There are at least four issues with your code...

1. You need to specify the sheet that the range you are searching is on.
2. You can not find an array. If you try it will only look for (first or
last I don't remember which) one of the items.
3. Find is an infinite loop. You want to stop when you get back to the firts
hit.
4. When you find nest you need to specify to start looking after the itme
you just found.

More like this...

Sub test()
Call findstuff("This")
Call findstuff("That")
End Sub

Sub findstuff(ByVal StringToFind As String)
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngCurrent As Range
Dim rngFirst As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Range("A1", "D100")

Set rngCurrent = rngToSearch.Find(StringToFind)
If rngCurrent Is Nothing Then
MsgBox "Not found"
Else
Set rngFirst = rngCurrent
Do
MsgBox rngCurrent.Value & vbTab & rngCurrent.Address
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngCurrent.Address = rngFirst.Address
End If

End Sub

--
HTH...

Jim Thomlinson


"John" wrote:

The following code pops up my msg box... meaning it doesn't find what I am
looking for. Any ideas why? Thanks for the help.

John


Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = Range("j7:j712")

Set rngFound = rngToSearch.Find(what:=Array(Range("d1").Value,
Range("d2").Value, Range("d3").Value, Range("d4").Value), LookIn:=xlValues,
lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Do
With Worksheets("vlookup")
Set DestCell = Range("a800").End(xlDown).Offset(1, 0)
End With
rngFound.EntireRow.Copy _
Destination:=DestCell
Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub

Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,069
Default Please help!
jim, that fixed the endless loop, but I am only getting one row pasted for
each macro (running it four times). Also, the time I run it with D1 value, I
am not getting the data pasted in correctly. Thanks alot for your help

here is the code I am using

Sub find()
Call colorprep(Sheets("data").Range("d1").Value)
Call colorprep(Sheets("data").Range("d2").Value)
Call colorprep(Sheets("data").Range("d3").Value)
Call colorprep(Sheets("data").Range("d4").Value)
End Sub
Sub colorprep(ByVal StringToFind As String)
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim rngFirst As Range
'Dim WhatToFind As Variant
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("DATA")
Set rngToSearch = wks.Range("j7:j712")

'WhatToFind = Array(Range("d1").Value, Range("d2").Value,
Range("d3").Value, Range("d4").Value)

Set rngFound = rngToSearch.find(StringToFind)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Set rngFirst = rngFound
Do
saddr = rngFirst.Address
myRow = rngFirst.Row
'rngFound.EntireRow.Copy
'Destination:=DestCell
Range("a" & myRow, "j" & myRow).Select
Selection.Copy
Sheets("vlookup").Select
Range("a65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound Is Nothing Or rngFound.Address = rngFirst.Address
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub





"Jim Thomlinson" wrote:

Give this a whirl...

Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim rngFirst As Range
'Dim WhatToFind As Variant
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = wks.Range("j7:j712") '***Changed

'WhatToFind = Array(Range("d1").Value, Range("d2").Value,
'Range("d3").Value, Range("d4").Value)

Set rngFound = rngToSearch.Find(what:=Sheets("data").Range("d1"). Value, _
LookIn:=xlValues, Lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Set rngFirst = rngFound '***Moved...
Do
'With Worksheets("vlookup")
'Set DestCell =
'Sheets("vlookup").Range("a65536").End(xlUp).Offse t(0, 1)
'End With

saddr = rngFound.Address
myrow = rngFound.Row
'rngFound.EntireRow.Copy
'Destination:=DestCell
Range("a" & myrow, "j" & myrow).Copy
Sheets("vlookup").Select
Range("a65536").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound Is Nothing Or rngFound.Address = rngFirst.Address
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub
--
HTH...

Jim Thomlinson


"John" wrote:

Jim thanks for the help. I am still having some issues.
It still seems to be in and endless loop (and I have taken out the array
just for testing). It also seems to copy cells that are to the right of my
rngToSearch column... as if it is moving over from that column rather than
starting on "d" or "a" or whatever column I select.

Here is the code now.
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim rngFirst As Range
'Dim WhatToFind As Variant
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = Sheets("data").Range("j7:j712")

'WhatToFind = Array(Range("d1").Value, Range("d2").Value,
Range("d3").Value, Range("d4").Value)

Set rngFound = rngToSearch.Find(what:=Sheets("data").Range("d1"). Value,
LookIn:=xlValues, Lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Do
'With Worksheets("vlookup")
'Set DestCell =
Sheets("vlookup").Range("a65536").End(xlUp).Offset (0, 1)
'End With
Set rngFirst = rngFound
saddr = rngFound.Address
myrow = rngFound.Row
'rngFound.EntireRow.Copy
'Destination:=DestCell
Range("a" & myrow, "j" & myrow).Copy
Sheets("vlookup").Select
Range("a65536").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound Is Nothing Or rngFound.Address = rngFirst.Address
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub

"Jim Thomlinson" wrote:

There are at least four issues with your code...

1. You need to specify the sheet that the range you are searching is on.
2. You can not find an array. If you try it will only look for (first or
last I don't remember which) one of the items.
3. Find is an infinite loop. You want to stop when you get back to the firts
hit.
4. When you find nest you need to specify to start looking after the itme
you just found.

More like this...

Sub test()
Call findstuff("This")
Call findstuff("That")
End Sub

Sub findstuff(ByVal StringToFind As String)
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngCurrent As Range
Dim rngFirst As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Range("A1", "D100")

Set rngCurrent = rngToSearch.Find(StringToFind)
If rngCurrent Is Nothing Then
MsgBox "Not found"
Else
Set rngFirst = rngCurrent
Do
MsgBox rngCurrent.Value & vbTab & rngCurrent.Address
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngCurrent.Address = rngFirst.Address
End If

End Sub

--
HTH...

Jim Thomlinson


"John" wrote:

The following code pops up my msg box... meaning it doesn't find what I am
looking for. Any ideas why? Thanks for the help.

John


Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = Range("j7:j712")

Set rngFound = rngToSearch.Find(what:=Array(Range("d1").Value,
Range("d2").Value, Range("d3").Value, Range("d4").Value), LookIn:=xlValues,
lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Do
With Worksheets("vlookup")
Set DestCell = Range("a800").End(xlDown).Offset(1, 0)
End With
rngFound.EntireRow.Copy _
Destination:=DestCell
Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub

Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 1,119
Default Please help!
This should cover it...

Sub find()
Call colorprep(Sheets("data").Range("d1").Value)
Call colorprep(Sheets("data").Range("d2").Value)
Call colorprep(Sheets("data").Range("d3").Value)
Call colorprep(Sheets("data").Range("d4").Value)
End Sub

Sub colorprep(ByVal StringToFind As String)
On Error GoTo ErrorHandler
Dim rngToSearch As Range
Dim wksData As Worksheet
Dim wksLookup As Worksheet
Dim rngFound As Range
Dim rngAllFound As Range
Dim rngFirst As Range
Dim rngDestination As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wksData = Sheets("Data")
Set wksLookup = Sheets("Lookup")
Set rngDestination = wksLookup.Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
Set rngToSearch = wksData.Range("j7:j712")
Set rngFound = rngToSearch.find(StringToFind)

If rngFound Is Nothing Then
MsgBox "No new Floaters"
Else
Set rngFirst = rngFound
Set rngAllFound = rngFound.Offset(0, -9).Resize(rngFound.Rows.Count, _
rngFound.Columns.Count + 9)
Do
Set rngAllFound = Union(rngAllFound, rngFound.Offset(0, -9) _
.Resize(rngFound.Rows.Count, rngFound.Columns.Count + 9))
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = rngFirst.Address
End If

'rngAllFound.EntireRow.Copy
rngAllFound.Select
rngAllFound.Copy
rngDestination.PasteSpecial Paste:=xlPasteValues

wksData.Select
wksData.Range("A6").Select

ErrorHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

--
HTH...

Jim Thomlinson


"John" wrote:

jim, that fixed the endless loop, but I am only getting one row pasted for
each macro (running it four times). Also, the time I run it with D1 value, I
am not getting the data pasted in correctly. Thanks alot for your help

here is the code I am using

Sub find()
Call colorprep(Sheets("data").Range("d1").Value)
Call colorprep(Sheets("data").Range("d2").Value)
Call colorprep(Sheets("data").Range("d3").Value)
Call colorprep(Sheets("data").Range("d4").Value)
End Sub
Sub colorprep(ByVal StringToFind As String)
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim rngFirst As Range
'Dim WhatToFind As Variant
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("DATA")
Set rngToSearch = wks.Range("j7:j712")

'WhatToFind = Array(Range("d1").Value, Range("d2").Value,
Range("d3").Value, Range("d4").Value)

Set rngFound = rngToSearch.find(StringToFind)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Set rngFirst = rngFound
Do
saddr = rngFirst.Address
myRow = rngFirst.Row
'rngFound.EntireRow.Copy
'Destination:=DestCell
Range("a" & myRow, "j" & myRow).Select
Selection.Copy
Sheets("vlookup").Select
Range("a65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound Is Nothing Or rngFound.Address = rngFirst.Address
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub





"Jim Thomlinson" wrote:

Give this a whirl...

Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim rngFirst As Range
'Dim WhatToFind As Variant
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = wks.Range("j7:j712") '***Changed

'WhatToFind = Array(Range("d1").Value, Range("d2").Value,
'Range("d3").Value, Range("d4").Value)

Set rngFound = rngToSearch.Find(what:=Sheets("data").Range("d1"). Value, _
LookIn:=xlValues, Lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Set rngFirst = rngFound '***Moved...
Do
'With Worksheets("vlookup")
'Set DestCell =
'Sheets("vlookup").Range("a65536").End(xlUp).Offse t(0, 1)
'End With

saddr = rngFound.Address
myrow = rngFound.Row
'rngFound.EntireRow.Copy
'Destination:=DestCell
Range("a" & myrow, "j" & myrow).Copy
Sheets("vlookup").Select
Range("a65536").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound Is Nothing Or rngFound.Address = rngFirst.Address
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub
--
HTH...

Jim Thomlinson


"John" wrote:

Jim thanks for the help. I am still having some issues.
It still seems to be in and endless loop (and I have taken out the array
just for testing). It also seems to copy cells that are to the right of my
rngToSearch column... as if it is moving over from that column rather than
starting on "d" or "a" or whatever column I select.

Here is the code now.
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim rngFirst As Range
'Dim WhatToFind As Variant
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = Sheets("data").Range("j7:j712")

'WhatToFind = Array(Range("d1").Value, Range("d2").Value,
Range("d3").Value, Range("d4").Value)

Set rngFound = rngToSearch.Find(what:=Sheets("data").Range("d1"). Value,
LookIn:=xlValues, Lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Do
'With Worksheets("vlookup")
'Set DestCell =
Sheets("vlookup").Range("a65536").End(xlUp).Offset (0, 1)
'End With
Set rngFirst = rngFound
saddr = rngFound.Address
myrow = rngFound.Row
'rngFound.EntireRow.Copy
'Destination:=DestCell
Range("a" & myrow, "j" & myrow).Copy
Sheets("vlookup").Select
Range("a65536").End(xlUp).Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound Is Nothing Or rngFound.Address = rngFirst.Address
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub

"Jim Thomlinson" wrote:

There are at least four issues with your code...

1. You need to specify the sheet that the range you are searching is on.
2. You can not find an array. If you try it will only look for (first or
last I don't remember which) one of the items.
3. Find is an infinite loop. You want to stop when you get back to the firts
hit.
4. When you find nest you need to specify to start looking after the itme
you just found.

More like this...

Sub test()
Call findstuff("This")
Call findstuff("That")
End Sub

Sub findstuff(ByVal StringToFind As String)
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngCurrent As Range
Dim rngFirst As Range

Set wks = ActiveSheet
Set rngToSearch = wks.Range("A1", "D100")

Set rngCurrent = rngToSearch.Find(StringToFind)
If rngCurrent Is Nothing Then
MsgBox "Not found"
Else
Set rngFirst = rngCurrent
Do
MsgBox rngCurrent.Value & vbTab & rngCurrent.Address
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngCurrent.Address = rngFirst.Address
End If

End Sub

--
HTH...

Jim Thomlinson


"John" wrote:

The following code pops up my msg box... meaning it doesn't find what I am
looking for. Any ideas why? Thanks for the help.

John


Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range
Dim DestCell As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("data")
Set rngToSearch = Range("j7:j712")

Set rngFound = rngToSearch.Find(what:=Array(Range("d1").Value,
Range("d2").Value, Range("d3").Value, Range("d4").Value), LookIn:=xlValues,
lookat:=xlWhole)
If rngFound Is Nothing Then
Range("a6").Select
MsgBox "No new Floaters"
Else
Do
With Worksheets("vlookup")
Set DestCell = Range("a800").End(xlDown).Offset(1, 0)
End With
rngFound.EntireRow.Copy _
Destination:=DestCell
Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Sheets("data").Select
Range("a6").Select
End Sub

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


All times are GMT +1. The time now is 05:16 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement