a Disaster in the Making - R/T error 1004

[JMay]

I've been trying to debug the below code for better than 3 hours, without
success.
Can someone help me?

Sub NewMatchStuff()
Set SRng = Worksheets("TheHdr").Range("D3", Range("D" & Rows.Count).End(xlUp))
Set DRng = Worksheets("Hdr formula").Range("A1:T1")
i = 1
With DRng
Do
Set g = .Find(SRng(i))
If Not g Is Nothing Then
faddress = g.Address
g.Offset(1).Value = SRng(i).Offset(0, -2).Value
End If
i = i + 1
Loop Until Not g Is Nothing
Do
Set g = Nothing 'Need to reset g to Nothing
Set g = .FindNext(SRng(i)) '*** R/T 1004 Here
i = i + 1
Loop While Not g Is Nothing And g.Address <> faddress
End With
End Sub

 

[JLGWhiz]

Not sure this is the problem, but you changed the value of SRng(i) in the
first loop, after it has been found and before the FindNext. re: i = i + 1

 

[Dave Peterson]

You have a bug here, too:

Set SRng = Worksheets("TheHdr").Range("D3", Range("D" & Rows.Count).End(xlUp))

If TheHdr isn't the activesheet, this will cause an error:

with worksheets("thehdr")
Set SRng = .Range("D3", .Range("D" & .Rows.Count).End(xlUp))
end with

(notice the dots in front of the second .range() object.)

Then delete this line:
Set g = Nothing

And change this line:
Set g = Nothing
to:
Set g = .FindNext(g)

That last line is equivalent to:
Set g = .findnext(after:=g)

(find it after the last one you found)

VBA's help for .findnext shows another example.

 

[JMay]

I'm trying to compare each cell in SRng with DRng and if there is a match
copy the content of Col B (2Cols to left) of SRng to 1 row below the matching
DRng Column

 

[Dave Peterson]

Maybe...

Option Explicit
Sub NewMatchStuff()

' I'm trying to compare each cell in SRng with DRng and if there is a match
' copy the content of Col B (2Cols to left) of SRng to 1 row below the
' matching dRng Column

Dim SRng As Range
Dim myCell As Range
Dim dRng As Range
Dim res As Variant

With Worksheets("TheHdr")
Set SRng = .Range("D3", .Range("D" & .Rows.Count).End(xlUp))
End With

Set dRng = Worksheets("Hdr formula").Range("A1:T1")

For Each myCell In SRng.Cells
res = Application.Match(myCell.Value, dRng, 0)
If IsError(res) Then
'no match
Else
myCell.Offset(0, -2).Copy _
Destination:=dRng(res).Offset(1, 0)
End If
Next myCell

End Sub

You may want to assign values (.value = .value) or copy|paste special|values. I
guessed with the code I used.

You could use .find if you wanted to. But if you use it, make sure you specify
all the parms. Don't rely on what you think the parms should be.

Excel and VBA share these settings. So if some other code or the user changes
something (values instead of formulas or part instead of whole), you may have an
intermittent bug that's difficult to find.

 

[JMay]

Dave,

Thanks Soooo much; I've printed out your code and explanation. I can follow
it's logic just fine.

Jim May