Consulting

Results 1 to 3 of 3

Thread: 'Unique Filter' applied on look back for multiple entries

  1. #1
    VBAX Tutor
    Joined
    Jul 2015
    Posts
    212
    Location

    'Unique Filter' applied on look back for multiple entries

    Ref the attachment 'Description' tab:
    In Range (A2:L2) data is updated every 2 seconds via 3rd party application. The Names remain the same, but Values may differ each update. I have code that copies and pastes the range (A2:L2) Sheet1 over to Sheet2, row by row. That's the easy bit. However I need to amend the code and add the logic statement:
    " If the data in Range (A2:L2) is NOT unique (Unique: There is no duplicate, for each name's cell values, in the ranges previously pasted), then don't copy and paste that name's range, wait till next refresh"

    For example 'John.4.3.5' appears in copy Range but is already in the Table, so isn't pasted, however 'Bill.5.2.4' and 'Mary.5.2.4', haven't been previously pasted so they're good to go!

    Now reason would say, "Why not apply 'Advanced Filter Unique' after the Table is populated?". Again too easy for my requirements, as another macro is assessing the last 3 Unique pastes and triggering another macro based on what it finds (still on the To Do list!), so it's a continually updating and firing process until the bot is stopped. If I can get past this hurdle with your help, I'll move onto the next problem.
    The basic code in need of amendment looks like this:
    Dim TimeToRun
    Sub StartTimer()
        Call ScheduleCopy_R1
    End Sub
    Sub Copy_R1()
        Application.ScreenUpdating = False
        Dim copySheet As Worksheet
        Dim pasteSheet As Worksheet
        Set copySheet = Worksheets("Sheet1")
        Set pasteSheet = Worksheets("Sheet2")
        copySheet.Range("A2:L2").Copy
        pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        StartTimer
    End Sub
    Sub ScheduleCopy_R1()
        TimeToRun = Now + TimeValue("00:00:02")
        Application.OnTime TimeToRun, "Copy_R1"
    End Sub
    Sub StopTimer()
       Application.OnTime TimeToRun, "Copy_R1", , False
    End Sub
    Attached Files Attached Files

  2. #2
    VBAX Tutor
    Joined
    Jul 2015
    Posts
    212
    Location
    Been working on this and got it going. Someone skilled, might be able to tidy it up for me. I placed a blank column between the names & data tables, so I could use 'CurrentRegion'. This then pastes to Sheet2 and then a new macro copied and pastes that to a revised table after applying Unique Records Filter to current table. It's a lot of duplication to achieve an end, but at least it works. The new codes:

    Sub Unique1()
     Dim TimeToRun
    Sub StartTimer()
        Call ScheduleCopy_R1
    End Sub
    Sub Copy_R1()
        Application.ScreenUpdating = False
        Dim copySheet As Worksheet
        Dim pasteSheet As Worksheet
        Set copySheet = Worksheets("Sheet1")
        Set pasteSheet = Worksheets("Sheet2")
        copySheet.Range("A2:N2").Copy
        pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        StartTimer
        Call Unique2
    End Sub
    Sub ScheduleCopy_R1()
        TimeToRun = Now + TimeValue("00:00:02")
        Application.OnTime TimeToRun, "Copy_R1"
    End Sub
    Sub StopTimer()
        Application.OnTime TimeToRun, "Copy_R1", , False
       
    End Sub
    Sub Unique2()
    Range("A1").CurrentRegion.AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=Range( _
            "Q1:T1"), Unique:=True
    Range("F1").CurrentRegion.AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=Range( _
            "U1:X1"), Unique:=True
    Range("K1").CurrentRegion.AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=Range( _
            "Y1:AB1"), Unique:=True
    End Sub

  3. #3
    VBAX Tutor
    Joined
    Jul 2015
    Posts
    212
    Location
    I've got a 24 of these code paragraphs stacked on top of each other. That was after implementing my test code to the real world scenario, I got Error '1004's so opted for this. Very stable running now, but seems inefficient?

    Sub Unique2()
    Sheets("GRAPHS").Range("C1:G20000").AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=Sheets("Unique").Range( _
            "C1:G1"), Unique:=True
    Sheets("GRAPHS").Range("I1:M20000").AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=Sheets("Unique").Range( _
            "I1:M1"), Unique:=True
    Sheets("GRAPHS").Range("O1:S20000").AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=Sheets("Unique").Range( _
            "O1:S1"), Unique:=True
    "Repeats another 21 times"

Posting Permissions

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