Permanent zoekvenster

[bascas]

Hallo,
In kolom B komen de namen te staan, maar dat gaan er wel 200 worden, nu wil ik graag een permanent zoekvenster waar als ik de naam invul van het apparaat excel het gevonden item/regel met een kleur aangeeft. De bedoeling is zoiets als het zoekvenster van excel zelf, maar dan kleiner en eenvoudiger, en permanent aanwezig.




Bekijk bijlage apparaatbeheer.zip

 

[Jack Nouws]

Hallo bascas,

Je kunt toch gebruik maken van een combobox.
Daarin kun je je items handig en snel op zoeken.

Met vr gr
Jack

 

[Ad Becude]

Of bedoel je zoiets, druk op B1 de knop.

 

[bascas]

Of bedoel je zoiets, druk op B1 de knop.

Ad, bedankt voor je antwoord, maar ik zie geen knop.

groet Bas

 

[Ad Becude]

Staat er boven in Blad Index cel B1 geen tekst "zoek"?........druk daar maar eens op.

 

[bascas]

Welk stukje code moet ik toevoegen om te zorgen dat datgene wat excel vind een andere kleur krijgt.

 

[Ad Becude]

bascas,

Ik ben zeker geen VBA man, maar met een beetje geknutsel heb ik wel iets voor elkaar gekregen. Ik denk dat als er een specialist naar kijkt wel iets valt te verbeteren.

Merk op:
Als je op de zoek knop drukt....en je bedenkt je eigen, en op Annuleren drukt kleurt de eerst lege rij. druk je weer op zoek word de rij weer wit.

 

[bascas]

Heren, inmiddels heb ik dit, maar loop tegen een paar probleempjes aan. Als je nu met de cursor door de cellen heen gaat, gaat het heel langzaam, dat ligt waarschijnlijk aan het stukje VBA. Als je nu een nummer weghaalt in kolom A, omdat je een fout hebt gemaakt, dan plaatst excel gelijk weer een tabblad erbij. Zou het zo kunnen, dat als je dat nummer weghaalt het tabblad met dat nummer ook gelijk verdwijnt?

Bekijk bijlage Apparaatbeheer.xls.zip

 

[Jack Nouws]

Hallo bascas,

Ik ben zo vrij geweest om je bestand (VBA) een beetje aan te passen. Ik heb een code geplaatst die het actieve rijnummer in cel A1 weergeeft.
Daarna heb ik dmv de voorwaardelijke opmaak geregeld dat de actieve rij wordt gekleurd.

zo ben je je lussen kwijt die elke keer doorlopen moeten worden als je van cel verandert (maakt het geheel sneller)

Met vr gr
Jack
Bekijk bijlage Apparaatbeheer.rar

 

[bascas]

Jack, bedankt, maar.... als het item nu niet gevonden is, krijg ik de melding dat het "with" gedeelte niet is gemaakt in het VBA. Ook maakt hij niet meer automatisch een tabblad aan. En de hyperlink wordt niet meer gezet. Ik denk dat er iets teveel VBA weggehaald is, daarentegen is hij nu wel een stuk sneller
Groeten Bas

 

[Jack Nouws]

Hallo bascas,

Ik ben zo vrij geweest om je bestand (VBA) een beetje aan te passen. Ik heb een code geplaatst die het actieve rijnummer in cel A1 weergeeft.
Daarna heb ik dmv de voorwaardelijke opmaak geregeld dat de actieve rij wordt gekleurd.

zo ben je je lussen kwijt die elke keer doorlopen moeten worden als je van cel verandert (maakt het geheel sneller)

Met vr gr
Jack

Dan kan nu de rest van de code geplaatst worden.
Ik heb nu geen tijd meer
Morgen wel
Of er reageren nog andere helpers

Met vr gr
Jack

 

[Ad Becude]

bascas,

En de hyperlink wordt niet meer gezet.

Dit was dus de veroorzaker van je trage bestand, bij elke celwissel wordt de macro uitgevoerd, om de hyperlinks te activeren....ook als er geen zijn aangemaakt.
Probeer deze maar eens:

 

[Warme bakkertje]

Waarom niet alles in 1 event ? Dan heb je toch geen probleem meer met loops en vertragingen en heb je geen andere event-macro's nodig.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo einde
With Target
 If .Column = 1 Then
 Sheets.Add(after:=Sheets(Sheets.Count)).Name = Target
 Cells(.Row, 9).Value = Cells(.Row, 1).Value
 End If
 Target.Offset(, 8).Hyperlinks.Add Anchor:=.Offset(, 8), Address:="", SubAddress:="'" & .Value & "'!A1", TextToDisplay:=" " & .Value
End With
 Sheets("1").Range("1:5").Copy Sheets(Sheets.Count).Range("1:5")
 Sheets(Sheets.Count).Columns.AutoFit
einde:
End Sub

 

[Ad Becude]

@Rudi,
Hier kan ik niet tegen op, maar toch een smetje Er wordt nu telkens 8 kolommen verder een hyperlink geplaatst, en dat is volgens mij niet de bedoeling. Ook een Application screenupdating=False zou niet misstaan.

Dit is niet negatief bedoeld hoor

 

[Warme bakkertje]

En de hyperlink wordt niet meer gezet

Dus ?? TS moet dan maar beslissen
Code nog wat aangepast bij lege cel in kolom 1.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error GoTo einde
With Target
    If .Column = 1 And .Value <> "" Then
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = Target
        Cells(.Row, 10).Value = Cells(.Row, 1).Value
        .Offset(, 9).Hyperlinks.Add Anchor:=.Offset(, 9), Address:="", SubAddress:="'" & .Value & "'!A1", TextToDisplay:=" " & .Value
    End If
End With
Sheets("1").Range("1:5").Copy Sheets(Sheets.Count).Range("1:5")
Sheets(Sheets.Count).Columns.AutoFit
einde:
With Application
    .ScreenUpdating = True
    .Goto Sheets("Index").Cells(Target.Row + 1, 1)
End With
End Sub

 

[paulva]

Heel wat simpeler dan dat van hierboven maar misschien is voorwaardelijke opmaak wel iets?Bekijk bijlage zoeken.xlsx

 

[Ad Becude]

@Rudi,

Ik heb het regeltje:
Cells(.Row, 10).Value = Cells(.Row, 1).Value weggehaald, en Offset(, 8 weer ,9 van gemaakt....en nu doet ie precies wat de bedoeling was

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error GoTo einde
With Target
    If .Column = 1 And .Value <> "" Then
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = Target
        .Offset(, 8).Hyperlinks.Add Anchor:=.Offset(, 8), Address:="", SubAddress:="'" & .Value & "'!A1", TextToDisplay:=" " & .Value
    End If
End With
Sheets("1").Range("1:5").Copy Sheets(Sheets.Count).Range("1:5")
Sheets(Sheets.Count).Columns.AutoFit
einde:
With Application
    .ScreenUpdating = True
    .Goto Sheets("Index").Cells(Target.Row + 1, 1)
End With
End Sub

@paulva,
Dat zou inderdaad werken, als er niet steeds nieuwe rijen bijkomen, je moet dan tekens je formule een eind doortrekken. Maar toch een mooie formule om te onthouden of op te slaan.

 

[Warme bakkertje]

@ Ad
Open het bestandje van #8 maar eens, dan zal je zien dat er nog een extra kolom serienummer tussenstaat. Daarom zitten we zo'n beetje te kl...en met die Offsets.
Ts moet hem dan zelf maar aanpassen naar het juiste bestand.

 

[bascas]

@ Ad
Open het bestandje van #8 maar eens, dan zal je zien dat er nog een extra kolom serienummer tussenstaat. Daarom zitten we zo'n beetje te kl...en met die Offsets.
Ts moet hem dan zelf maar aanpassen naar het juiste bestand.

Oeps, sorry
Heren, bedankt voor de aandacht. Heb met de diverse codes inmiddels dit:

Bekijk bijlage Copy of Apparaatbeheer.xls.zip

En er zijn gelijk een paar problemen die ik had verdwenen, dat is mooi dus! Alleen er is iets voor in de plaats gekomen. Als je nu in een cel op enter drukt ongeacht waar je staat wordt de actieve cel een cel in kolom A. dat is wel lastig met invoeren.
En... zou het mogelijk zijn om de naam van het apparaat ergens in de kop van het betreffende tabblad te krijgen ( automatisch wel te verstaan).
Na het zoeken laat excel een gele balk achter vanaf kolom U, hierdoor wordt het bestand erg groot.

Groeten Bas

 

[Warme bakkertje]

Haal bij de event-macro de regel met Goto eruit, dan is je probleem van de selectie in de A-kolom opgelost.
Wat betreft de kleur, die had je toch zelf gevraagd ? Zou het niet handiger zijn dat ipv te kleuren de gevonden cel wordt geselecteerd ?