Problem in this code

[Nader]

I tried this code but didn't work. What is the mistake.
Dim i As Long
Dim LastRow2 As Long
Dim LastRow3 As Long
Dim TargetRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With Worksheets("Sheet1")

LastRow2 = .Cells(.Rows.Count, "D").End(xlUp).Row

End With

With Worksheets("Material")

LastRow3 = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow3

TargetRow = 0
On Error Resume Next
TargetRow = .Evaluate("MATCH(1,(sheet1!D1:D" & LastRow2 & "=D" & i & ")*" & _
"(sheet1!E1:E" & LastRow2 & "=E" & i & ")*" & _
"(sheet1!F1:F" & LastRow2 & "=F" & i & ")*" & _
"(sheet1!G1:G" & LastRow2 & "=G" & i & "),0)")
On Error GoTo 0
If TargetRow > 0 Then

Worksheets("sheet1").Cells(TargetRow, "I").Resize(, 2).Copy .Cells(i, "F")
End If
Next i
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

[Bob Phillips]

A bit more detail in what didn't work, why, what it should do might help.

[Norie]

The first thing I suggest you do is remove On Error Resume Next.

All it's doing is hiding the type mismatch error happening here.

TargetRow = .Evaluate("MATCH(1,(sheet1!D1:D" & LastRow2 & "=D" & i & ")*" & _
"(sheet1!E1:E" & LastRow2 & "=E" & i & ")*" & _
"(sheet1!F1:F" & LastRow2 & "=F" & i & ")*" & _
"(sheet1!G1:G" & LastRow2 & "=G" & i & "),0)")

As to why you are getting the error, as xld has mentioned, we need more details.:)

[Nader]

the code didn't copy any thing
did you download the Problem xls file.

[Bob Phillips]

Yes, but as it did nothing, it is very difficult to work out what it is supposed to do. If you want us to helkp you, help us, don't leave it to us to figure everything out.

[Norie]

Of course I downloaded the file.

And as I said the first thing you should do is remove On Error Resume Next.

All that is doing is hiding an error - specifically a type mismatch error.

As to why that error is happening it's hard to tell without further information like xld has suggested.

[Nader]

This code was sent to me XLD I made some change of it to becam my
code Above and here is the link of Page http://www.vbaexpress.com/forum/showthread.php?t=17776

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" ' I delete this and place of it "D" ,"A"
Dim i As Long
Dim LastRow2 As Long
Dim LastRow3 As Long
Dim TargetRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With Worksheets("Sheet3")

LastRow3 = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row

.Range("H1").Resize(LastRow3).Formula = "=SUMPRODUCT(-- (Sheet2!$A$1:$A$10=A1),--(Sheet2!$B$1:$B$10=B1),--(Sheet2!$C$1:$C$10=C1),--(Sheet2!$D$1:$D$10=D1),Sheet2!$H$1:$H$10)" ' I delete this
End With

With Worksheets("Sheet2")

LastRow2 = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow2

TargetRow = 0
On Error Resume Next
' I change the range A,B.C.D .. bY D,E,F,G
TargetRow = .Evaluate("MATCH(1,(Sheet3!A1:A" & LastRow3 & "=A" & i & ")*" & _
"(Sheet3!B1:B" & LastRow3 & "=B" & i & ")*" & _
"(Sheet3!C1:C" & LastRow3 & "=C" & i & ")*" & _
"(Sheet3!D1:D" & LastRow3 & "=D" & i & "),0)")
On Error Goto 0
If TargetRow > 0 Then
' I change E,E ..By I,F
Worksheets("Sheet3").Cells(TargetRow, "E").Resize(, 3).Copy .Cells(i, "E")
End If
Next i
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

[Norie]

Is there any chance you'll tell us what the code is meant to do?

If there isn't then I think I'll bail from this thread for now.:)

[Bob Phillips]

My thoughts exactly!