Help with Find

G

gaba

Hi everybody,
This piece of code I'm using is "almost doing" what I intended it to do. The
problem I'm having is that is SrcChk1 is reading always the first value and
not comparing the offsets values. I've tried to fix it with the italic font,
but nothing is working. What I'm looking for is to go thru column C in
"Method ids" and find the value, if the font is not italic and offset (0,-1)
= DestChk2 the copy the values. The first empy cell in column c is giving me
an error.

Any Help will be appreciated.

Sub SetElementsWW()
'method ids contains the data needed
'ppb data contains the value(s) (DestChk)I use to look up the value I need
(SrcFnd)
'if DestChk is true, then the value is returned otherwise Null (0) is entered

Dim MethRange As Range, SrcChk1 As Range
Dim SrcFnd1 As String, DestChk1 As String
Dim DestChk2 As String

myfilename = ActiveSheet.Range("H3").Value

Set MethRange = Sheets("Method Ids").Range("C3:C61")
Sheets("ppb " & myfilename & " data").Range("B16").Select
Do
DestChk1 = ActiveCell.Offset(0, 0).Value
DestChk2 = ActiveCell.Offset(0, 1).Value
Set SrcChk1 = MethRange.Find(What:=DestChk1, LookAt:=xlWhole, _
SearchOrder:=xlByRows)

If Not SrcChk1 Is Nothing Then
If SrcChk1.Offset(0, 0).Font.Italic = False And SrcChk1.Offset(0,
-1) = DestChk2 Then

SrcFnd1 = SrcChk1.Offset(0, -2).Value
ActiveCell.Offset(0, -1).Value = SrcFnd1
ActiveCell.Offset(0, 2).Value = SrcChk1.Offset(0, 4).Value

Else
ActiveCell.Offset(0, -1).Value = ""
End If 'font
End If

If IsEmpty(ActiveCell) Then
ActiveCell.Value = ""
End If

ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, 0))
Range("E2").Select
End Sub

Method ids:
B C

51 V
52 Cr
53 Cr
54 Fe
55 Mn
57 Fe
59 Co
60 Ni
63 Cu
65 Cu
66 Zn
67 Zn
68 Zn
 
G

gaba

I'v answer my own question. Just in case somebody else has the same question:

Set SrcChk1 = MethRange.Find(What:=DestChk1, LookAt:=xlWhole, _
SearchOrder:=xlByRows)

On Error Resume Next
For Each c In MethRange
If Not SrcChk1 Is Nothing Then
If c.Offset(0, 0).Font.Italic = False Then
If c.Offset(0, -1) = DestChk2 Then
SrcFnd1 = SrcChk1.Offset(0, -2).Value
ActiveCell.Offset(0, -1).Value = SrcFnd1
ActiveCell.Offset(0, 2).Value = SrcChk1.Offset(0, 4).Value

End If
Err.Clear

End If 'font
End If 'nothing
Next
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top