add string in random cells of column for each same id

[fatoom91]

Hi I'm trying to add string = "bid canceled" in a column in range 2 to 6 time for each same Auction-ID if the bid status is empty:

Private Sub Bidcanceled_Click()
 Application.ScreenUpdating = False

    Dim Bidstatus As Range, rng As Range, rng1 As Range, x As Integer, N As Long
    Dim str As String
     N = Cells(Rows.Count, "A").End(xlUp).Row
     Set rng = Range("H2:H" & N)
     str = "bid canceled"
       For Each Bidstatus In rng
        Select Case Int(Rnd * 10) Mod 2
        Case 1: lb = 2: ub = 6
        End Select
        x =
       ' Do While Application.WorksheetFunction.CountIf(rng, x) >= 1
           Do While Application.WorksheetFunction.CountIfs(rng.Offset(, -1), Bidstatus.Offset(, -1), rng, x) >= 1
            x =
        Loop
        Bidstatus = x
    Next
   Application.ScreenUpdating = True

End Sub

the attachment in sheet one is the output that I except, I didnt know how to insert string 2 times or 3 or 4 ...6 times in random cells for each auction id if the cells are empty,any idea for that?

[WideBoyDixon]

Give this a try:

Public Sub RandomCancel()

Dim lastRow As Long
Dim thisRow As Long
Dim lastID As Variant
Dim blankRows As Collection
Dim randomCancels As Long
Dim randomRow As Long

Randomize Now
lastID = ""
lastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
For thisRow = 2 To lastRow
    If Cells(thisRow, "A").Value <> lastID Then
        If lastID <> "" Then
            randomCancels = Int(Rnd * 5) + 2
            If randomCancels > blankRows.Count Then randomCancels = blankRows.Count
            Do While randomCancels > 0
                randomRow = Int(Rnd * blankRows.Count) + 1
                Cells(blankRows(randomRow), "H").Value = "bid canceled"
                blankRows.Remove randomRow
                randomCancels = randomCancels - 1
            Loop
        End If
        
        lastID = Cells(thisRow, "A").Value
        Set blankRows = New Collection
    End If
    
    If Cells(thisRow, "H").Value = "" Then blankRows.Add thisRow
Next thisRow

End Sub

WBD

[fatoom91]

Give this a try:

Public Sub RandomCancel()

Dim lastRow As Long
Dim thisRow As Long
Dim lastID As Variant
Dim blankRows As Collection
Dim randomCancels As Long
Dim randomRow As Long

Randomize Now
lastID = ""
lastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
For thisRow = 2 To lastRow
    If Cells(thisRow, "A").Value <> lastID Then
        If lastID <> "" Then
            randomCancels = Int(Rnd * 5) + 2
            If randomCancels > blankRows.Count Then randomCancels = blankRows.Count
            Do While randomCancels > 0
                randomRow = Int(Rnd * blankRows.Count) + 1
                Cells(blankRows(randomRow), "H").Value = "bid canceled"
                blankRows.Remove randomRow
                randomCancels = randomCancels - 1
            Loop
        End If
        
        lastID = Cells(thisRow, "A").Value
        Set blankRows = New Collection
    End If
    
    If Cells(thisRow, "H").Value = "" Then blankRows.Add thisRow
Next thisRow

End Sub

WBD

thanks so much

[Richard Buttrey]

Your upload was a .xlsx file and therefore didn't contain the macro. Please upload the .xlsm file

In addition please indicate in a narrative form exactly what you want to do, the rules you apply and for a few of your results explain how you arrived at them.

It seems there's an element of randomness in your system, but rather than reverse engineer your macro, which presumably isn't giving the results you want since you've raised the problem here, I'd rather know the overall aim.