Does this do what you want?
Code:Sub RandIfEmpty() Const StartNum = 10000000 'Set the lowest number Const EndNum = 99999999 'Set the highest number Dim R As Range, c As Range, d As Object, X As String On Error Resume Next Set R = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks) On Error GoTo 0 If R Is Nothing Then Exit Sub Set d = CreateObject("Scripting.dictionary") Application.ScreenUpdating = False For Each c In R Again: X = "TEMP" & Int((EndNum - StartNum + 1) * Rnd + StartNum) If Not d.exists(X) Then d.Add X, d.Count + 1 With c .Value = X .EntireRow.Font.Color = vbRed End With Else GoTo Again End If Next c Columns("A").AutoFit Application.ScreenUpdating = True End Sub
Like this thread? Share it with others