Genereren lijst met waarden uit x-matrix op ander werkblad

[tonissteiner]

Hallo,

ik heb wat raad maar vooral hulp nodig bij het schrijven van een (wat mij betreft uitgebreide) code. Ik heb een bestand met twee werkbladen. Op het werkblad "X-Matrix" (waar ik voor het schrijven van een code voor dit werkblad hulp kreeg van VenA) heb ik een tabel die zowel verticaal als horizontaal moet gelezen worden.
Op het werkblad "Mechanical Checklist" zou ik via een knop een lijst willen genereren met bepaalde waarden uit het tweede werkblad. Het tijdelijke werkblad "Voorbeeld" zou moeten weergeven waar ik naartoe wil. Als in cel D12 van het werkblad "Mechanical Checklist" een waarde gekozen wordt (dit zal automatisch gebeuren maar heb dit in dit bestand met een vervolgkeuzelijst gedaan) en op de knop "Genereer lijst" gedrukt wordt zou een code volgende handelingen moeten doen:
1) zoek op werkblad "X-Matrix" in horizontale lijnen welke "Controlepunten" er aangeduid zijn
2) creëer op het werkblad "Mechanical Checklist" een lijn met deze tekst, volgens het sjabloon in rij 28, de benaming van het bereik is "Controlepunt_sjabloon"
3) zoek op werkblad "X-Matrix" in verticale richting welke "Onderdelen" er aangeduid zijn voor deze "Controlepunten" en
4) creëer op het werkblad "Mechanical Checklist" een lijn met deze tekst, volgens het sjabloon in rijen 25-26, de benaming van het bereik is "Onderdeel_sjabloon"
5) de keuzerondjes zouden mee gekopieerd of gecreëerd worden, met een koppeling naar een cel in kolom J
6) indien het keuzerondje onder "OK with comment" aangevinkt zou worden moet volgens het sjabloon in rijen 30-31 (de benaming is "Comment_sjabloon" deze rijen onder deze rij moeten ingevoegd worden
7) het kader rond de groep box rond de keuzerondjes zou moeten verborgen worden

Na rij 34 zou de eerste lijn moeten beginnen.

Het is een hele boterham en alle hulp is meer dan welkom.
Is het een goed idee van mij om met deze sjablonen te werken?
Bestaat er een andere en beter manier dan deze keuzerondjes en koppeling naar een cel om de commentaar lijn in te voegen?

Bekijk bijlage Controlelijst - Helpmij.xlsm

Alvast bedankt.

mvg,

Stefan

 

[VenA]

Lang verhaal en niets terug te vinden. Probeer zelf maar eens wat dan lezen we wel waar je tegenaan loopt.

 

[tonissteiner]

Ja inderdaad lang verhaal, sorry. heb het zo goed mogelijk proberen omschrijven.
Wat bedoel je met niets terug te vinden? alle werkbladen en named ranges staan toch in het document in bijlage?
Is het al een goed idee van mij om rijen te kopiëren die als sjabloon dienen (rijen 24 t/m 32) en van hieruit verder te werken of worden die beter in een code gecreëerd? Lijnen kopiëren kan volgens mij problemen geven omdat keuzerondjes dan ook mee gekopieerd worden. Voor keuzerondjes heb ik ook geen beter idee.

 

[VenA]

Je hebt over code die je eerder van mij hebt gekregen. Hier is niets van terug te vinden. Zelf wat proberen blijft staan. Helpmij.nl <> Maakvoormij.nl

 

[tonissteiner]

Hallo VenA. Ja dat klopt, die code heb ik er bewust uit gelaten omdat het niks met deze vraag te maken heeft, enkel verwarring zou brengen dacht ik en het bestand enkel groter zou maken. Sorry daarvoor. Maar vindingrijke mensen kunnen je code eenvoudig terugvinden, ik heb in het onderwerp speciaal twee keer de benaming X-matrix gebruikt.
Ik heb reeds pogingen gedaan die op niks uitdraaiden. Ik zal deze inderdaad posten om te bewijzen dat ik wel degelijk probeer en jullie me kunnen bijspringen met jullie hulp.
Jammer genoeg ben ik een totale leek en haal mijn codes hier en daar en zijn het vaak samenraapsels van andere codes die ik ergens vond.
Ik heb ook niemand in mijn onmiddellijke omgeving die me kan helpen. Zelfs tegen betaling vind ik niemand. Als iemand bereid zou zijn het tegen vergoeding te doen sta ik daarvoor open. Ik heb zelf al in een paar vorige vragen mijn dank geuit naar jullie en gevraagd of er geen mogelijkheid is een soort donatie te doen.

mvg,

Stefan

 

[tonissteiner]

Ik ben codes aan het proberen combineren maar loop vast.
De eerste code is van Ron de Bruin en hiermee kan ik een waarde vinden die op een ander werkblad staat:

Sub Find_First()
    Dim FindString As String
    Dim Rng As Range
    FindString = Sheets("Mechanical Checklist").Range("D12").Value
    If FindString = "" Then
            MsgBox "Selecteer een ""Base Model""!", vbInformation, "Information"
    Else
        If Trim(FindString) <> "" Then
            With Sheets("X-Matrix").Range("VoertuigTypes")
                Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
                If Not Rng Is Nothing Then
                    Application.Goto Rng, True
                Else
                    MsgBox "Voertuig type bestaat nog niet!", vbInformation, "Information"
                End If
            End With
        End If
    End If
End Sub

Met een tweede code van Ron zou ik in de kolom van de actieve cel willen gaan zoeken naar de "ü"
maar loop dus vast op de lijn:

With Sheets("X-Matrix").Range(ActiveCell.Address).EntireColumn

in volgende code:

Sub Copy_To_Another_Sheet_1()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim r As Range
    Dim Rcount As Long
    Dim I As Long
    Dim NewSh As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Fill in the search Value
    MyArr = Array("ü")

    'You can also use more values in the Array
    'myArr = Array("@", "www")

    'Add new worksheet to your workbook to copy to
    'You can also use a existing sheet like this
    'Set NewSh = Sheets("Sheet2")
    Set NewSh = Worksheets.Add

    'With Sheets("X-Matrix").Range("N:N")
    With Sheets("X-Matrix").Range(ActiveCell.Address).EntireColumn
         
        Rcount = 0

        For I = LBound(MyArr) To UBound(MyArr)

            'If you use LookIn:=xlValues it will also work with a
            'formula cell that evaluates to "@"
            'Note : I use xlPart in this example and not xlWhole
            Set Rng = .Find(What:=MyArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1

                    Rng.Copy NewSh.Range("A" & Rcount)

                    ' Use this if you only want to copy the value
                    ' NewSh.Range("A" & Rcount).Value = Rng.Value

                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Kan iemand me helpen wat ik verkeerd doe?

Nadat ik hier een oplossing voor heb kan ik verder knutselen.

Alvast bedankt.