Worksheet.Function add another "Do while"

[MarkCBB]

Hi there,

I need to add anther argument to this code:

Sub TestRun()
Range("A1") = InputBox("How many Winners would you like to pick?")
MsgBox ("This is a test run. All test winners will be cleared afterwards!")
        Range("B2").Select
Do
        ActiveCell.Formula = "=INDEX(OFFSET(Entries!$A$1,1,0,COUNTA(Entries!A:A)),RANDBETWEEN(1,COUNTA(Entries!A:A)-1))"



Do While WorksheetFunction.CountIf(ActiveCell.EntireColumn, ActiveCell.Value) > 1
Do While WorksheetFunction.CountIf(ActiveCell.Offset(1, 0).EntireColumn, ActiveCell.Value) > 1

Loop
        
    ActiveCell.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Offset(0, -1) = ""
MsgBox ("" & Range("A1").Value & " Random test winner/s have been selected!")
MsgBox ("Test Run Complete! " & Range("A1").Value & " Test winner/s will now be cleared")
Range("B2:B100").ClearContents
Range("B2").Select
End Sub

I need at add another do while that checks that the column to the right also has a count of one.

 

[MarkCBB]

ahhhh,

I was trying to complicate somthing simple, columns "B" was the index i.e. all value where unqiue, however that didnt mean that the Column "C" was unique, however I only wanted unique entries from column "C". so just offset the Active cell to Column "C". and if the count was great than 1 then it just recalculates as normal.

here is the ammended Code for any one intrested.

This calculates a random/s from a list of SMS entries (MSISDN = Column "C")

Sub TestRun()
Range("A1") = InputBox("How many Winners would you like to pick?")
MsgBox ("This is a test run. All test winners will be cleared afterwards!")
        Range("B2").Select
Do
        ActiveCell.Formula = "=INDEX(OFFSET(Entries!$A$1,1,0,COUNTA(Entries!A:A)),RANDBETWEEN(1,COUNTA(Entries!A:A)-1))"
Calculate
Calculate
Calculate
Calculate
Calculate
Calculate
Calculate
Calculate
Calculate
Do While WorksheetFunction.CountIf(ActiveCell.Offset(0, 1).EntireColumn, ActiveCell.Offset(0, 1).Value) > 1
Calculate
Calculate
Calculate
Calculate
Calculate
Calculate
Calculate
Calculate
Loop
        
    ActiveCell.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Offset(0, -1) = ""
MsgBox ("" & Range("A1").Value & " Random test winner/s have been selected!")
MsgBox ("Test Run Complete! " & Range("A1").Value & " Test winner/s will now be cleared")
Range("B2:B101").ClearContents
Range("B2").Select
End Sub
Sub ActualRun()
Range("A1") = InputBox("How many Winners would you like to pick?")
MsgBox ("This is an Actual Run!")
        Range("B2").Select
Do
         ActiveCell.Formula = "=INDEX(OFFSET(Entries!$A$1,1,0,COUNTA(Entries!A:A)),RANDBETWEEN(1,COUNTA(Entries!A:A)-1))"
Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
        Calculate
Do While WorksheetFunction.CountIf(ActiveCell.EntireColumn, ActiveCell.Value) > 1
Loop
        
    ActiveCell.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Offset(0, -1) = ""

    MsgBox ("" & Range("A1").Value & " Winner/s have been selected!")
    Range("A1").Select
    ActiveSheet.Unprotect
    ActiveCell.CurrentRegion.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Pictures.Paste.Select
    Application.CutCopyMode = False
    Windows("RandomEntrySelect_Template_v2R.xlsm").Activate
    ActiveWorkbook.Save
    MsgBox ("Actual Run Complete! All Results are now in a new excel sheet. Results will now be cleared.")
    Range("B2:B100").ClearContents
    Sheets("WINNERS!!!!").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Range("A1").Select
End Sub

yay, I answered my own question!!

 

[MarkCBB]

yup me again,

Just found out that I need to only index the visable cell on the "Entries1" worksheet.

ActiveCell.Formula = "=INDEX(OFFSET(Entries!$A$1,1,0,COUNTA(Entries!A:A)),RANDBETWEEN(1,COUNTA(Entries!A:A)-1))

Can anyone help me ammend this formula to look at only the visable cells?