Willekeurige Naam Kiezen

[gerArt]

Beste allemaal,


Wie kan mij verder helpen. In Blad1 staan namen (dit zijn nu karakters). Via de knop naam kiezen wordt er uit deze namen een willekeurig gekozen en in cel G12 gezet voorwaarde is dat dit voldoet aan de tijd die in de macro staat. Soms komt het voor dat er in cel G12 een 0 komt te staan. Hoe kan ik dit voorkomen. Het aantal namen verschilt per keer.

De code heb ik gevonden en aangepast.

MvG G.

 

[roeljongman]

het probleem zit in de indexformule die je in cell G12 zet

die start namelijk op AN1 die altijd leeg is, dus als het willekeurige getal uit de RANDBETWEEN functie 1 is dan wordt cell AN1 gekozen en daar staat niks of 0
als je de [-11] aanpast naar [-10] dan zou dat probleem opgelost moeten zijn volgens mij.


De tweede loop om de gekozen naam te kleuren heb ik vervangen door een .find, dat voorkomt onnodig loopen door veel cellen om 1 cel te vinden en kleuren.
deze aanpassing heeft geen effect op het probleem, je kunt ook de oude loop laten staan.

Sub NaamKiezen()
Application.ScreenUpdating = False
Dim cell As Range

Range("L15:AG150").Interior.ColorIndex = 2
Range("AN2:An50").ClearContents
   
   With ActiveSheet
        For Each cell In Range("M15:AG50")
            If cell.Value Like "*19:30" Then
            ActiveSheet.Cells(Rows.Count, 40).End(xlUp).Offset(1).Value = cell.Offset(0, -1).Value
            End If
        Next cell
   End With
     
   Range("G12") = "=INDEX(R[-10]C40:R[37]C40,RANDBETWEEN(1,COUNTA(R[-10]C40:R[37]C40)),1)"
   Range("G12").Value = Range("G12").Value
   Range("AN2:AO50").ClearContents
 
  Range("L15:AG150").Find(Range("G12")).Interior.ColorIndex = 43
End Sub

 

[gerArt]

Hallo,

Ik heb jouw aanpassing doorgevoerd en getest. Ben nog geen gekke dingen tegengekomen. Mijn dank is groot.

Wellicht is er een betere oplossing te vinden om willekeurig een naam te kiezen maar vooralsnog ben ik content met deze.

:thumb:

 

[VenA]

Maak gebruik van VBA

Sub VenA()
  With Sheets("Blad1").Range("L15:AG150")
    .Interior.ColorIndex = 2
    ar = .Value
    For j = 1 To UBound(ar)
      For jj = 2 To UBound(ar, 2)
        If InStr(ar(j, jj), "19:30") Then c00 = c00 & "|" & ar(j, jj - 1)
      Next jj
    Next j
    If Len(c00) > 0 Then
      x = Split(Mid(c00, 2), "|")
      y = x(Application.RandBetween(0, UBound(x)))
      .Parent.Cells(12, 7) = y
      .Find(y).Interior.ColorIndex = 43
    End If
  End With
End Sub

 

[gerArt]

Ha VenA,

Helemaal geweldig. :thumb:

 

[gerArt]

Toch nog een vraag. Is het ook mogelijk om een tweede naam te kiezen en deze dan in cel G13 te zetten.

 

[Timshel]

Sub VenA()
    With Sheets("Blad1").Range("L15:AG150")
        .Interior.ColorIndex = 2
        ar = .Value
        For j = 1 To UBound(ar)
            For jj = 2 To UBound(ar, 2)
                If InStr(ar(j, jj), "19:30") Then c00 = c00 & "|" & ar(j, jj - 1)
            Next jj
        Next j
        If Len(c00) > 0 Then
            x = Split(Mid(c00, 2), "|")
            For j = 0 To 1
                y = x(Application.RandBetween(0, UBound(x)))
                .Parent.Cells(12, 7).Offset(j) = y
                .Find(y).Interior.ColorIndex = 43
                x = Filter(x, y, False)
            Next
        End If
    End With
End Sub

 

[gerArt]

Helemaal geweldig weer. Mijn dank is groot.