weg schrijven naar juiste regel

[popipipo]

Ik schrijf via VBA extra gegevens in een blad door het aanklikken van een naam in dezelfde regel

Als ik echter een naam aanklik 20 regels lager dan schrijft hij het toch weer weg in de hierboven genoemd bereik.
Ik dacht dit zo op te lossen:
verander dit:

Range("H4").Value = strCmt

in dit:

Range("H" & Row().Select).Value = strCmt

Dit werkt echter niet. Hoe moet het wel??

 

[Niels28]

Als het goed is dit:

Cells(ActiveCell.Row(), 8).Value = strCmt

Niels

 

[popipipo]

Als het goed is dit:

Helaas is het (net) niet goed.
en net niet goed is eigenlijk helemaal fout.

Het wordt wel weggeschreven naar de juiste cel.
Echter de gegevens blijven staan als je een ander cel aanklikt en dat is nou net niet de bedoeling.
Dan had ik net zo goed de functie vertikaal zoeken kunnen gebruiken.

 

[Cobbe]

Heb je hier iets aan?

Private Sub Worksheet_[COLOR="red"][B]Change[/B][/COLOR](ByVal Target As Range)
Dim wsCmt As Worksheet
Dim strCmt As String
Dim rngCmt As Range
Set wsCmt = Worksheets("CommentList")
Set rngCmt = wsCmt.Range("CommentList")

On Error Resume Next
strCmt = [deel1] & Chr(10) & Application.WorksheetFunction.VLookup(Target.Value, rngCmt, 2, 0) & Chr(10) & Chr(10) & _
         [deel2] & Chr(10) & Application.WorksheetFunction.VLookup(Target.Value, rngCmt, 3, 0)

[COLOR="red"][B]Target.Offset(0, 6) [/B][/COLOR]= strCmt
'Range("H" & Row().Select).Value = strCmt

End Sub

Gr. Cobbe

 

[Niels28]

Zo wel?

Cells(ActiveCell.Row(), 8).Select
Cells(ActiveCell.Row(), 8).Value = strCmt

Niels

 

[popipipo]

Nee helaas hij werkt net zoals de oplossing van niels.

Als je mijn bestandje bekijk zie je dat als je op cel B4; C4; D4 klikt de extra gegevens in cellen H4:N21 komen te staan.
Ga je op een ander cel staan is dit bereik weer leeg.
In cellen H4:H21 zie je niets staan.

Nu wil ik dus als je op Cel B24; C24; D24 klik de gegevens in H24:N41 verschijnen.
H4:H21 zijn dan weer leeg.

 

[popipipo]

Range("H4:N61").ClearContents
Cells(ActiveCell.Row(), 8).Select
Cells(ActiveCell.Row(), 8).Value = strCmt

Ik heb er dit van gemaakt.
Uit de eerste test lijkt deze het goed te doen.

 

[zapatr]

Range("H4:N61").ClearContents
[b]Cells(ActiveCell.Row(), 8).Select[/b]
Cells(ActiveCell.Row(), 8).Value = strCmt

Om een waarde in een cel te plaatsen, hoef je die cel niet eerst te selecteren.
De hierboven vetgedrukte regel kun je dus weglaten.
Het wordt dan ook wat 'rustiger' in het blad als je namen aanklikt.

 

[popipipo]

OK, dit werkt nu.

Maar zoals zo vaak doemen er nieuwe problemen op.
In het originele bestand wordt alles toch wel traag.
Ik denk dat het komt door het bereik (hele tabblad)
Eigenlijk heb ik aan een tiental cellen genoeg.
Hoe kan ik de range nog opgeven.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim wsCmt As Worksheet
Dim strCmt As String
Dim rngCmt As Range
Set wsCmt = Worksheets("CommentList")
Set rngCmt = wsCmt.Range("CommentList")

    With Range("b4:d4,b24:d24,b44:d44,b64:d64")

On Error Resume Next
strCmt = [deel1] & Chr(10) & Application.WorksheetFunction.VLookup(Target.Value, rngCmt, 2, 0) & Chr(10) & Chr(10) & _
         [deel2] & Chr(10) & Application.WorksheetFunction.VLookup(Target.Value, rngCmt, 3, 0)

    Range("H3:N61").ClearContents
    Cells(ActiveCell.Row(), 8).Value = strCmt
    
    End With

End Sub

 

[Warme bakkertje]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim wsCmt As Worksheet
Dim strCmt As String
Dim rngCmt As Range
Set wsCmt = Worksheets("CommentList")
Set rngCmt = wsCmt.Range("CommentList")

If not Intersect(Target,Range("b4:d4,b24:d24,b44:d44,b64:d64")) is nothing then

On Error Resume Next
strCmt = [deel1] & Chr(10) & Application.WorksheetFunction.VLookup(Target.Value, rngCmt, 2, 0) & Chr(10) & Chr(10) & _
         [deel2] & Chr(10) & Application.WorksheetFunction.VLookup(Target.Value, rngCmt, 3, 0)

    Range("H3:N61").ClearContents
    Cells(ActiveCell.Row(), 8).Value = strCmt
    
    End if

End Sub

 

[popipipo]

Thanks.!!

Het originele bestand is inderdaad een stuk sneller geworden.