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
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