tekst uit een cel in een opmerking ander cel plaatsen

[MMarie]

Wat ik graag wil is het volgende:
in 1 tabblad staan gegevens met een bepaald volgnummer. Nu wil ik de tekst in 1 cel automatisch weergeven op het andere tabblad in een opmerking in een cel met hetzelfde volgnummer.
Is dit mogelijk? Ik heb zelf al wat zoekwerk gedaan maar kom er niet uit.

Zie voorbeeld bestand.
Bekijk bijlage Test1.xlsx

 

[MMarie]

Heeft niemand een idee om mij in de juiste richting te krijgen? Of is het gewoon niet mogelijk?

 

[Conseclusie]

Met VBA is dit eenvoudig op te lossen, maar graag je vraag iets concreter maken... De tekst van wélke cel wil je als opmerking zetten in wélke andere cel?

 

[MMarie]

De tekst in kolom D op blad 2 op de rij met nr 1 moet terecht komen in een opmerking in de cel van blad1 waar ook een 1 in staat. Een soort verticaal zoeken is het dus.
Andersom gezien, als in blad1 in een cel een 1 staat moet de macro zoeken op blad2 naar hetzelfde nr in kolom A en vervolgende de tekst van kolom D in de opmerkingveld plaatsen.

Duidelijker zo?

 

[Conseclusie]

Hangt onderstaande macro in Blad2:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Intersect(Target, Range("D2:D7")) Is Nothing) Then
    Sheets("Blad1").Cells(4, Target.Column - 1).ClearComments
    Sheets("Blad1").Cells(4, Target.Column - 1).AddComment Target.Value
End If
End Sub

 

[MMarie]

Ik ga het vanavond testen...ik laat het je nog weten

 

[MMarie]

Hij doet wel iets maar nog niet wat ik bedoel. De macro doet alleen iets als je de cel D2 wijzigt. De macro zou dan de tekst in de cel waar een 1 in staat in een opmerking moeten zetten maar hoe zet de opmerking in de cel waar een 3 in staat. En hij geeft een foutmelding (1004) als ik de cel op blad2 weer leeg haal.
Wat zou ik moeten aanpassen?
Bekijk bijlage Test3.xlsm

 

[HSV]

Met een druk op een knop?

Sub hsv()
Dim cl As Range, c As Range
With Sheets("blad1")
 For Each cl In .Cells(4, 1).CurrentRegion
    cl.ClearComments
    Set c = Sheets("blad2").columns(1).Find(cl, , , 1)
  If Not c Is Nothing Then cl.AddComment c.Offset(, 3).Text
 Next cl
End With
End Sub

Of met extra voorwaarde dat de cellen in kolom D een tekst hebben.

Sub hsv()
Dim cl As Range, c As Range
With Sheets("blad1")
 For Each cl In .Cells(4, 1).CurrentRegion
    cl.ClearComments
    Set c = Sheets("blad2").Columns(1).Find(cl, , , 1)
  If Not c Is Nothing Then
    If c.Offset(, 3) <> "" Then cl.AddComment c.Offset(, 3).Text
End If
 Next cl
End With
End Sub

 

[MMarie]

De bedoeling is niet met een knop maar zodra je een tekst invoert.
Jouw tweede optie werkt nog niet, snap niet helemaal wat er mis gaat, hij zet de tekst niet in de juiste cel lijkt,
terwijl de eerste optie van jou bij een druk op de knop dit wel doet.

Bekijk bijlage Test3.xlsm

 

[HSV]

De tweede code werkt prima als jij die change_event eruit had gehaald.

Wat jij dus wilt is een code die, en bij elke wijziging in kolom D, en voor de gegevens die al in kolom D staan?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range, c As Range
If Not Intersect(Target, Columns(4)) Is Nothing Then
Application.EnableEvents = False
 With Sheets("blad1")
     For Each cl In .UsedRange
        cl.ClearComments
        Set c = Columns(1).Find(cl, , , 1)
      If Not c Is Nothing Then
        If c.Offset(, 3) <> "" Then cl.AddComment c.Offset(, 3).Text
      End If
     Next cl
 End With
Application.EnableEvents = True
End If
End Sub

 

[MMarie]

Dit werkt helemaal top!
Om het voor mezelf te begrijpen, het zoeken van het juiste nummer wordt aangegeven met 'Set c = Columns(1).Find(cl, , , 1), klopt dat?

En is het ook mogelijk om in de code mee te nemen dat de kleur van de cel links van de tekst cel op blad2, ook wordt overgenomen in de cel in blad 1 waar de opmerking geplaatst is?

 

[HSV]

Dat klopt.

Voor de kleur.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range, c As Range
If Not Intersect(Target, Columns(4)) Is Nothing Then
Application.EnableEvents = False
 With Sheets("blad1")
     For Each cl In .UsedRange
        cl.ClearComments
        Set c = Columns(1).Find(cl, , , 1)
      If Not c Is Nothing Then
        If c.Offset(, 3) <> "" Then
           cl.AddComment c.Offset(, 3).Text
           cl.Interior.Color = c.Offset(, 2).Interior.Color
        End If
      End If
     Next cl
 End With
Application.EnableEvents = True
End If
End Sub

 

[MMarie]

De kleur verandert nu enkel als je kolom D aanpast. Dat komt door de regel 'For Each cl In .UsedRange' die in het eerdere stukje zit.
Ik heb gezocht naar een 'For Each' die ervoor zorgt bij elke verandering de macro uit te voeren maar kan het niet vinden.
Of moet er nog een for each geplaatst worden apart voor de kleurwijziging?

En de laatste vraag, wat als de verwijzing naar die volgnummers ingewikkelder is.
Ipv 1, 2, 3 staat er Straat 1, waarbij de 1 nog steeds in de cel staat en de straatnaam onder het blok. Misschien handig om die straatnamen in kolom A (of indien mogelijk gewoon ook onder het blok in kolom B) te zetten, de blokken met de nummers staan dan altijd in de kolommen vanaf B, middels een samenvoeg functie (straat en 1) moet dan de match gemaakt worden met blad 2. Weet niet of het uberhaupt mogelijk is?

Bekijk bijlage Test5.xlsm

 

[HSV]

De code is gemaakt als er een wijziging plaats vindt in kolom D, daar help een extra lus niet bij.

Zoiets voor de namen?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range, c As Range
If Not Intersect(Target, Columns(4)) Is Nothing Then
Application.EnableEvents = False
 With Sheets("blad1")
     For Each cl In .UsedRange
        cl.ClearComments
[COLOR=#0000ff]        Set c = Columns(1).Find("straat " & cl, , , 1)[/COLOR]
      If Not c Is Nothing Then
        If c.Offset(, 3) <> "" Then
           cl.AddComment c.Offset(, 3).Text
           cl.Interior.Color = c.Offset(, 2).Interior.Color
        End If
      End If
     Next cl
 End With
Application.EnableEvents = True
End If
End Sub

 

[MMarie]

Dit werkt idd perfect als je alleen de tekst "straat" hebt staan onder een blok. Maar in werkelijkheid kunnen er dus verschillende straatnamen in voorkomen. Hij moet dan dus voor dat blok zoeken naar die straatnaam en het nummer. straat is dus variabel. Kan ik dat ook nog kwijt in de code?

 

[HSV]

Probeer het zo maar eens.

Set c = Columns(1).Find("*" & cl, , , 1)

 

[MMarie]

Helaas, dat is niet de oplossing. Nu worden er opmerkingen geplaatst in de cellen naast de straatnaam.

 

[HSV]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range, c As Range
If Not Intersect(Target, Columns(4)) Is Nothing Then
Application.EnableEvents = False
 With Sheets("blad1")
     For Each cl In [COLOR="#0000FF"].UsedRange.SpecialCells(2)[/COLOR]
        cl.ClearComments
        [COLOR="#0000FF"]cl.Interior.ColorIndex = xlNone[/COLOR]
        Set c = Columns(1).Find("*" & cl, , , 1)
      If Not c Is Nothing Then
        If c.Offset(, 3) <> "" Then
           cl.AddComment c.Offset(, 3).Text
           cl.Interior.Color = c.Offset(, 2).Interior.Color
        End If
      End If
     Next cl
 End With
Application.EnableEvents = True
End If
End Sub

 

[MMarie]

Excuses voor de late reactie. De moed zakte een beetje in mijn schoenen omdat het nog niet helemaal werkte. Wil graag dat het werkt, maar heb er te weinig verstand van (=frustratie).

Op zich vind ie de juiste cel wel nu, maar dezelfde opmerking wordt ook in de del met straatnaam geplaats. (zie bestand) Is daar nog wat op te bedenken misschien?

 

[HSV]

Verwijder de samengevoegde cellen.
Jammer dat Ms-office zulke waardeloze instrumenten er in laat en goede verwijderd bij nieuwe versies.