Consulting

Results 1 to 9 of 9

Thread: Problem in this code

  1. #1

    Question Problem in this code

    I tried this code but didn't work. What is the mistake.
    [VBA]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" & 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[/VBA]

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    A bit more detail in what didn't work, why, what it should do might help.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Master Norie's Avatar
    Joined
    Jan 2005
    Location
    Stirling, Scotland
    Posts
    1,831
    Location
    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.
    [vba]
    TargetRow = .Evaluate("MATCH(1,(sheet1!D1" & LastRow2 & "=D" & i & ")*" & _
    "(sheet1!E1:E" & LastRow2 & "=E" & i & ")*" & _
    "(sheet1!F1:F" & LastRow2 & "=F" & i & ")*" & _
    "(sheet1!G1:G" & LastRow2 & "=G" & i & "),0)")
    [/vba]
    As to why you are getting the error, as xld has mentioned, we need more details.

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

  5. #5
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    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.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  6. #6
    VBAX Master Norie's Avatar
    Joined
    Jan 2005
    Location
    Stirling, Scotland
    Posts
    1,831
    Location
    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.

  7. #7
    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" & 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

  8. #8
    VBAX Master Norie's Avatar
    Joined
    Jan 2005
    Location
    Stirling, Scotland
    Posts
    1,831
    Location
    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.

  9. #9
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    My thoughts exactly!
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •