Hi, I'm trying to compose a code in which I'm copying new values from Sheet3 (in code I select range by hand), but I'd like excel to keep track of which rows are new. Now I select values from Sheet3 column A based on if value from same row's D column is equal to Sheet2 B column value. Also I need to do such copying with every 16th blank cell from Sheet2 column H. Here's what I've composed so far:
Sub randomize()
Application.ScreenUpdating = False
Dim RNG1 As Range, RNG2 As Range, r As Range, p As Range, d As Collection, N As Long
Set RNG1 = Application.InputBox(Prompt:="Select Range", Type:=8)
Set RNG1 = Sheet3.Range("A1:A65536")
Set RNG2 = Sheet2.Range("B2:B12")
For Each p In RNG2
Set d = New Collection
For Each r In RNG1
If Sheet3.Cells(r.Row, 1).Value <> vbNullString And p.Value <> vbNullString And Sheet3.Cells(r.Row, 4).Value = p.Value Then
d.Add r
N = Application.WorksheetFunction.RandBetween(1, d.Count)
Set rselect = d.Item(N)
rselect.Copy
Sheet2.Cells(p.Row, 8).PasteSpecial Paste:=xlPasteValues
End If
Next r
Set d = Nothing
Next p
Application.ScreenUpdating = True
End Sub
Sub randomize()
Application.ScreenUpdating = False
Dim RNG1 As Range, RNG2 As Range, r As Range, p As Range, d As Collection, N As Long
Set RNG1 = Application.InputBox(Prompt:="Select Range", Type:=8)
Set RNG1 = Sheet3.Range("A1:A65536")
Set RNG2 = Sheet2.Range("B2:B12")
For Each p In RNG2
Set d = New Collection
For Each r In RNG1
If Sheet3.Cells(r.Row, 1).Value <> vbNullString And p.Value <> vbNullString And Sheet3.Cells(r.Row, 4).Value = p.Value Then
d.Add r
N = Application.WorksheetFunction.RandBetween(1, d.Count)
Set rselect = d.Item(N)
rselect.Copy
Sheet2.Cells(p.Row, 8).PasteSpecial Paste:=xlPasteValues
End If
Next r
Set d = Nothing
Next p
Application.ScreenUpdating = True
End Sub