Automatische suggestie van ingevoerde tekst en waardes

[mvanbe]

Beste Mensen,

Bij deze een kleine vraag waar hopelijk iemand het verlossende antwoord op heeft; voor mij tot nu een grote uitdaging

Ik heb een invoersheet waar ik in een vaste opmaak inventarisaties wegschrijf. Nu komt het regelmatig voor dat er repeterende objecten zijn.
De tabel geeft automatisch in kolom D "Omschrijving" een suggestie van wat reeds is ingevoerd; is het ook mogelijk dat bij deze suggestie ook de kolommen I en J worden gekopieerd?

 

[JEC.]

Plaats anders even je bestand

 

[mvanbe]

Bij deze toegevoegd

 

[JEC.]

Je zou het zo kunnen doen. De kolommen R S en T zijn verborgen. Deze worden automatisch gevuld met een macro waarin je vervolgens kunt zoeken vanuit je tabel.

 

[HSV]

Zonder extra kolommen en de intensieve selectionchange.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim old, c As Range
With Application
   .EnableEvents = False
 If Not Intersect(Target, ListObjects(1).Range.Columns(3)) Is Nothing Then
   old = Target
   .Undo
 Set c = ListObjects(1).Range.Columns(3).Find(old, , , xlWhole)
  If Not c Is Nothing Then
     Target.Resize(, 7) = Array(old, "", "", "", "", c.Offset(, 5), c.Offset(, 6))
   Else
     .Undo
   End If
  End If
  .EnableEvents = True
 End With
End Sub

 

[mvanbe]

Hartelijk dank heren! Beide opties werken! Hiervoor mijn dank en compliment.

Heb het nog niet uitgebreid getest maar ik merk bij de eerste optie een lichte vertraging; wellicht een wat zware belasting.

De 2de optie doet het subliem; alleen deze raakt overstuur zodra er regels worden ingevoegd, verwijderd, gekopieerd of geplakt. Is daar misschien een oplossing voor te bedenken?

 

[HSV]

Een intelligente tabel vergt toch een andere benadering dan gedacht.

Test het zo maar eens weer.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim old, c As Range
With Application
   .EnableEvents = False
 If Not Intersect(Target, ListObjects(1).DataBodyRange.Columns(3)) Is Nothing Then
 If Not Target Is Nothing And Target.Count = 1 Then
   old = Target
   .Undo
 Set c = ListObjects(1).Range.Columns(3).Find(old, , , xlWhole)
  If Not c Is Nothing Then
     Target.Resize(, 7) = Array(old, "", "", "", "", c.Offset(, 5), c.Offset(, 6))
   Else
     .Undo
   End If
  End If
  End If
  .EnableEvents = True
  .CutCopyMode = False
 End With
End Sub

 

[mvanbe]

Bedankt voor het meedenken! Beide oplossingen werken en de correctie op de laatste werkt perfect. Dank hiervoor

 

[mvanbe]

Toevoeging; op beide oplossingen werkt de UNDO functie niet meer; verklaarbaar door de VBA functie maar is er misschien een handige oplossing of work-around om dit (tijdelijk) op te lossen?

 

[HSV]

Laat eens aan de hand van je bestand zien met welke handelingen je doet om dat te realiseren.

 

[mvanbe]

Wellicht was ik wat voorbarig met mijn conclussie; een nieuwe ronde leert dat de UNDO functie gewoon actief blijft. Ik blijf het even actief volgen! Bedankt HSV voor betrokkenheid

 

[HSV]

Je mag er ook dit van maken als je het niet vertrouwd.

Else
    Target = old

 

[mvanbe]

@ HSV; Mag ik nog éénmaal een beroep doen op je kennis en kunde?

Ik heb je functie geplaatst op 2 tabbladen; 1 origineel zoals je me hebt geholpen en bij 1 heb ik een kolom (F) toegevoegd. Helaas werkt de functie nu niet meer en kan ik niet ontdekken wat gewijzigd moet worden of wat het verschil is. (Ook niet op goed geluk )

Onderstaand je code en een afbeelding van de nieuwe situatie.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim old, c As Range
With Application
   .EnableEvents = False
 If Not Intersect(Target, ListObjects(1).DataBodyRange.Columns(4)) Is Nothing Then
 If Not Target Is Nothing And Target.Count = 1 Then
   old = Target
   .Undo
 Set c = ListObjects(1).Range.Columns(4).Find(old, , , xlWhole)
  If Not c Is Nothing Then
     Target.Resize(, 7) = Array(old, "", "", "", "", "", c.Offset(, 5), c.Offset(, 6))
   Else
     .Undo
   End If
  End If
  End If
  .EnableEvents = True
  .CutCopyMode = False
 End With

 
End Sub

[ATTACH]347021.vB[/ATTACH]

 

[HSV]

Op goed geluk zonder wat de bedoeling is valt vaak tegen.
Ik zie dat je van de 3 een 4 gemaakt hebt.
Wil je daarin typen?

Plaats eens je bestand met de veranderde situatie.

 

[mvanbe]

Bekijk bijlage testbestand.xlsm

Bij deze. Ik heb het nog wat aangepast en het lijkt nu beter te staan maar misschien dat jou scherpe blik iets opvalt?

 

[HSV]

Werkt prima toch, of is er iets niet naar je zin?

 

[mvanbe]

Klopt! Het werkt prima;

Tussen plaatsen en reactie heb ik het met goed geluk toch goed aangepast; Omschrijving inderdaad (kolom 4) en onderstaand. De werking heb ik nog niet kunnen ontdekken maar dit is niveau gevorderden denk ik

Target.Resize(, 7) = Array(old, "", "", "", "", "", c.Offset(, 5), c.Offset(, 6))

Bedankt voor je hulp!

 

[HSV]

Zo schrijf je het in een keer weg, maar als er al iets staat in de kolommen F,G,H,I, en J dan worden ze wel leeggemaakt door de "" in de array.

Anders wordt het zoiets.

Target = old
target.offset(,5) =  c.Offset(, 5)
target.offset(,6) = c.Offset(, 6)