Randomization move then delete

[Paul Bray-Boyce]

Hello Everyone, I typically do not post questions because if you look hard enough someone else posted the same question or had the same challenges. I created / tweaked / modified Code that would take a range then randomly Select on of the cells then populate the data in a different cell (Source / destination) my code is attach and works as design.

My Question is would it be possible to 1. after copying the randomly select content from defined range to delete the selected item from the source. 2nd question is could there be an option that would some how save the original range content for "X" number of minutes in case I need to reset and source.

Sub Teamshift10()

Dim SrcRange As Range, FillRange As Range
Dim c As Range, r As Long
Set SrcRange = Range("w56:y56")
Set FillRange = Range("u63")
If FillRange.Cells.Count > SrcRange.Cells.Count Then
    MsgBox "Fill range too large"
    Exit Sub
End If
r = SrcRange.Cells.Count
For Each c In FillRange
Do
c.Value = WorksheetFunction.Index(SrcRange, Int((r * Rnd) + 1))
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next

End Sub
[code\]

 

[Stevie]

Hiya Paul,
Your code looks pretty savvy to me, why not try something as simple as:

Sub Teamshift10()

Dim SrcRange As Range, FillRange As Range
Dim c As Range, r As Long, hold As Long
Set SrcRange = Range("w56:y56")
Set FillRange = Range("u63")
If FillRange.Cells.Count > SrcRange.Cells.Count Then
    MsgBox "Fill range too large"
    Exit Sub
End If
r = SrcRange.Cells.Count
For Each c In FillRange
Do
hold = Int((r * Rnd) + 1)
c.Value = WorksheetFunction.Index(SrcRange, hold)
WorksheetFunction.Index(SrcRange, hold).ClearContents
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next

End Sub

i.e. create the random integer first then use it to give c a value and remove the data.

As for saving the original content for x minutes, I would suggest simply saving the document before using, then you have a backup.
Either that or..

sub copy()
Sheets("Sheet1").Range("W56:Y56").copy
Sheets("Sheet2").Range("A1").pastespecial xlpastevalues
end sub

As a different macro to run before you start, in order to copy your range to another sheet for safe keeping until you decide you don't need it.

Hope this helps!

 

[Paul Bray-Boyce]

Stevie, thank you for keeping it simple, I clearly was over engineering a solution. Also wanted to thank you for tweaking the code. it works for what I need it do...

Hopefully some day i can return the favor.