find and paste - help with code

[Les Stout]

Hello all, I have been trying to modify some code to do the following,
A B C D E E
0014166 0141 6771230 11 01 14-Feb-07
6771230 3614
6765118 2152 2753438 11 01 09-Apr-07
Sheet "Tool Tracking"


A B C D E F
6771230 97 ZEAFHZP VA37 Z013261 20070620
6774767 VG96 2734467 20070317

Sheet"LCS"


I need to compare the numbers in "A" on both sheets, if found on both
sheets, check "Tool Tracking" for value in "C", if nothing then check
"E" on "LCS" if there is a value then copy cell in "E" from sheet"LCS"
to "Tool Tracking" - The value "Z013261" in the example above must be
copied to "C" in sheet "Tool Tracking".

Some code would be greatly appreciated.

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

 

[Bob Phillips]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim shLCS As Worksheet
Dim iRow As Long

Set shLCS = Worksheets("LCS")
With Worksheets("Tool Tracking")

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To iLastRow
iRow = 0
On Error Resume Next
iRow = Application.Match(.Cells(i, TEST_COLUMN),
shLCS.Columns(1), 0)
On Error GoTo 0
If iRow > 0 Then
If .Cells(i, "C").Value = "" Then
.Cells(i, "C").Value = shLCS.Cells(iRow, "E").Value
End If
End If
Next i

End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Tom Ogilvy]

Sub Fill_Column_C()
Dim shLCS As Worksheet, shTrk As Worksheet
Dim rLCS As Range, rTrk As Range
Dim r1 As Range, r2 As Range
Dim cell As Range, res As Variant
Set shLCS = Worksheets("LCS")
With shLCS
Set rLCS = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
End With

Set shTrk = Worksheets("Tool Tracking")
With shTrk
Set rTrk = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
End With

For Each cell In rTrk
If Len(Trim(cell.Offset(0, 2))) = 0 Then
res = Application.Match(cell.Value, rLCS, 0)
If Not IsError(res) Then
Set r1 = rLCS(res)
Set r2 = r1.Offset(0, 4)
If Len(Trim(r2)) <> 0 Then
cell.Offset(0, 2).Value = r2
End If
End If
End If
Next

End Sub

 

[Les Stout]

Thank you so much Bob and Tom, as always i really appreciate your
help... Great day further, im off home it is 22:15 here... ;0)

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

 

[Les Stout]

Sorry Tom, just a further question, i am also using your code to copy
over a date in the format 20070223, but on the KTL sheet where it gets
copied to the cell format is set as "dd-mmm-yy" and when it copies it in
it just shows ################ is there a way around this ??

Best regards,

Les Stout

*** Sent via Developersdex http://www.developersdex.com ***

 

[Tom Ogilvy]

Make the column wider. If that doesn't work,
Look at the value stored in the cell. Format the cell as General.

What is in the Cell.