View Full Version : Problem in this code
Nader
03-02-2008, 08:11 AM
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
03-02-2008, 08:15 AM
A bit more detail in what didn't work, why, what it should do might help.
Norie
03-02-2008, 08:20 AM
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
03-02-2008, 09:47 AM
the code didn't copy any thing
did you download the Problem xls file.
Bob Phillips
03-02-2008, 10:33 AM
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
03-02-2008, 11:45 AM
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
03-04-2008, 08:22 AM
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
03-04-2008, 08:36 AM
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
03-04-2008, 09:44 AM
My thoughts exactly!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.