Het maken van een loop in VBA

[Arito]

Ik had deze vraag eigenlijk ook gesteld in een topic waarin ik met een andere vraag ben begonnen, maar daar kwam ik er niet uit. Dat was dit topic:

http://www.helpmij.nl/forum/showthread.php?t=422802

Ik dacht dat het duidelijker zou zijn om een nieuw topic te openen.

Ik heb de volgende code:

Range("O5").hyperlinks.Add _
        Range("O5"), Columns(30).Find(Range("K5"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address

        Range("O6").hyperlinks.Add _
        Range("O6"), Columns(30).Find(Range("K6"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O7").hyperlinks.Add _
        Range("O7"), Columns(30).Find(Range("K7"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O8").hyperlinks.Add _
        Range("O8"), Columns(30).Find(Range("K8"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O9").hyperlinks.Add _
        Range("O9"), Columns(30).Find(Range("K9"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O10").hyperlinks.Add _
        Range("O10"), Columns(30).Find(Range("K10"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O11").hyperlinks.Add _
        Range("O11"), Columns(30).Find(Range("K11"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O12").hyperlinks.Add _
        Range("O12"), Columns(30).Find(Range("K12"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O13").hyperlinks.Add _
        Range("O13"), Columns(30).Find(Range("K13"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O14").hyperlinks.Add _
        Range("O14"), Columns(30).Find(Range("K14"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O15").hyperlinks.Add _
        Range("O15"), Columns(30).Find(Range("K15"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O16").hyperlinks.Add _
        Range("O16"), Columns(30).Find(Range("K16"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O17").hyperlinks.Add _
        Range("O17"), Columns(30).Find(Range("K17"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address

        Range("O18").hyperlinks.Add _
        Range("O18"), Columns(30).Find(Range("K18"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O19").hyperlinks.Add _
        Range("O19"), Columns(30).Find(Range("K19"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O20").hyperlinks.Add _
        Range("O20"), Columns(30).Find(Range("K20"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O21").hyperlinks.Add _
        Range("O21"), Columns(30).Find(Range("K21"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O22").hyperlinks.Add _
        Range("O22"), Columns(30).Find(Range("K22"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O23").hyperlinks.Add _
        Range("O23"), Columns(30).Find(Range("K23"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O24").hyperlinks.Add _
        Range("O24"), Columns(30).Find(Range("K24"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O25").hyperlinks.Add _
        Range("O25"), Columns(30).Find(Range("K25"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O26").hyperlinks.Add _
        Range("O26"), Columns(30).Find(Range("K26"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O27").hyperlinks.Add _
        Range("O27"), Columns(30).Find(Range("K27"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O28").hyperlinks.Add _
        Range("O28"), Columns(30).Find(Range("K28"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address
        
        Range("O29").hyperlinks.Add _
        Range("O29"), Columns(30).Find(Range("K29"), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).hyperlinks(1).Address

Dit gaat door tot cel O200. Is er een manier om dit wat korter neer te zetten dmv een loop?

Meestal staat er alleen data in de eerste 10 a 20 cellen (O5:O25), maar het zou kunnen voorkomen dat er data verder komt te staan in bijvoorbeeld O200.


bvd,

 

[Wigi]

On Error Resume Next
    
    For Each r In Range("O5:O200").SpecialCells(2)
        r.Hyperlinks.Add r, Columns(30).Find(r.Offset(, -4), lookat:=xlWhole, LookIn:=xlValues).Offset(, 1).Hyperlinks(1).Address
    Next
    
    On Error GoTo 0

 

[Arito]

Het wilt niet echt lukken. Ik heb een voorbeeldsheet gemaakt waarin de originele (lange) macro wordt geactiveerd door de onderste knop en de nieuwe (die van jou) door de bovenste. De bovenste knop doet het niet, de onderste wel.

 

[snb]

Private Sub CommandButton1_Click()
  For Each r In Range("B5:B200").SpecialCells(xlCellTypeFormulas)
    If r.Text <> "" Then r.Hyperlinks.Add r, Columns(5).Find(r.Text).Hyperlinks(1).Address
  Next
End Sub

 

[Wigi]

De bovenste knop doet het niet, de onderste wel.

Als je dan al gelijk een bestand had bijgevoegd

 

[snb]

@WiGi 120% mee eens

 

[Arito]

Beide bedankt! Het werkt nu. Ik doe er normaliter altijd een voorbeeldsheet bij maar ik dacht dat het deze keer geen meerwaarde had. Zal het voortaan altijd doen.