PDA

View Full Version : 'Unique Filter' applied on look back for multiple entries



RINCONPAUL
07-21-2016, 05:08 PM
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

RINCONPAUL
07-21-2016, 08:54 PM
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

RINCONPAUL
07-22-2016, 12:14 AM
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"