Results 1 to 6 of 6
  1. #1
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    HEAD FIRED!!!!! (2000 sr 1)

    Why the macro recopy and dlete from DEP_A into STORICO the line ....
    In effcet before to delete and copy from DEP_A and insert into STORICO i would want to controll uasing column G in STORICO if alreday existis a a bvalue equal from DEP_A...
    Example:
    If into STORICO column G alreday existis 144264 not delete and copy from DEP_A, copy only from DEP_a the line when into STORICO not is present...
    Sub DEFINITE_1()

    Dim N As Long, PR As Long, S2 As String, S3 As String
    Dim RNG As Range

    S2 = "DEP_A"
    S3 = "STORICO"
    N = 3
    PR = Worksheets(S3).Range("A65536").End(xlUp).Row + 1
    With Sheets(S2)
    Do Until .Cells(N, 1) = ""

    Set RNG = Sheets(S2).Range("G:G").Find(.Cells(N, 7))
    If Not RNG Is Nothing Then
    .Range(.Cells(N, 1), .Cells(N, 10)).Copy
    Sheets(S3).Cells(PR, 1).PasteSpecial xlPasteValues
    .Rows(N).Delete
    PR = PR + 1
    End If
    N = N + 1
    Loop
    End With

    End Sub

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: HEAD FIRED!!!!! (2000 sr 1)

    1) You want to check if the value is already present in the STORICO sheet. S3 = "STORICO", so you must change the line

    Set RNG = Sheets(S2).Range("G:G").Find(.Cells(N, 7))

    to

    Set RNG = Sheets(S3).Range("G:G").Find(.Cells(N, 7))

    2) You want to copy and delete a row if the value is NOT found, i.e. if RNG is Nothing. Change the line

    If Not RNG Is Nothing Then

    to

    If RNG Is Nothing Then

  3. #3
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: HEAD FIRED!!!!! (2000 sr 1)

    Hans...
    Have a dubt to set the correct range, row and column based your code take a eye...

    The index is in column E

    Sub DEFINITE()

    Dim N As Long, PR As Long, S1 As String, S2 As String, S3 As String
    Dim rng As Range

    Application.ScreenUpdating = False

    S1 = "SERVIZIO"
    S2 = "GAF"
    S3 = "DEFINITE"

    N = 2

    PR = Worksheets(S3).Range("A65536").End(xlUp).Row + 1

    ' Test for matches between S1 and S2
    With Sheets(S2)
    Do Until .Cells(N, 1) = ""
    Set rng = Sheets(S1).Range("E:E").Find(.Cells(N, 5))
    If rng Is Nothing Then
    ' No match - copy row from S2 to S3
    .Range(.Cells(N, 1), .Cells(N, 17)).Copy
    Sheets(S3).Cells(PR, 1).PasteSpecial xlPasteValues
    .Rows(N).Delete
    PR = PR + 1
    Else
    ' Match - delete row from S1
    rng.EntireRow.Delete
    N = N + 1
    End If
    Loop

    ' Copy remaining rows from S1 to S2
    PR = Sheets(S1).Range("A65536").End(xlUp).Row
    If PR > 2 Then
    Sheets(S1).Range("2:" & PR).Copy .Range("A" & N)
    Sheets(S1).Range("2:" & PR).Delete
    End If
    End With

    Application.ScreenUpdating = True

    End Sub

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: HEAD FIRED!!!!! (2000 sr 1)

    Which sheets do you want to compare this time?

  5. #5
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: HEAD FIRED!!!!! (2000 sr 1)

    GAF and SERVIZIO
    and insert the deleted line about the mach in DEFINITE
    SERVIZIO is the new sheet with new data and GAF the old sheet with data...

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: HEAD FIRED!!!!! (2000 sr 1)

    As far as I can tell, it works OK.

Posting Permissions

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