Na het vinden van een waarde in 3e tabblad alleen waarde ingevulde waarde kopieren.

Status
Niet open voor verdere reacties.
R

Robert09

Gebruiker
Lid geworden
6 dec 2012
Berichten
34
Hallo
Ik wil graag een nummer vinden in tabblad 3 en wanneer deze gevonden is de ingevulde velden meenemen.
Ben al de helemiddag bezig maar ik zit muur vast graag doe ik een beroep op jullie expertise.

Onderstaande code heb ik tot nu toe.
Code: 
Sub Find_First()
    Dim ClearForm As Range 'Range selecteren voor leegmaken van blad 2
    Dim Rng As Range
    Rows.EntireRow.Hidden = False
    If MsgBox("Wil je doorgaan?", vbOKCancel, "Mijn titel") = vbCancel Then Exit Sub 'MessageBox met de vraag of je door wilt gaan ja/nee
            With Sheets(3).Range("C:C")
            Set Rng = .Find(What:=Sheets(2).Range("D3"), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
                            
            
If Rng Is Nothing Then
MsgBox "Garantie nummer niet gevonden!", vbOKOnly + vbCriticalm, "Nummer niet gevonden"  'MessageBox met melding dat garantie nummer niet gevonden is.
Exit Sub

ElseIf Sheets(2).Range("D4", "D5", "D7") Is Not Empty Then
Rng.Offset(0, 6).Value = Sheets(2).Range("D4")  'invullen status
Rng.Offset(0, 7).Value = Sheets(2).Range("D5") 'invullen negatief
Rng.Offset(0, 9).Value = Sheets(2).Range("D7") 'invullen gebeld Ja/Nee

ElseIf Sheets(2).Range("D4", "D6", "D7") Is Not Empty Then
Rng.Offset(0, 6).Value = Sheets(2).Range("D4")  'invullen status
Rng.Offset(0, 7).Value = Sheets(2).Range("D6") 'invullen positief
Rng.Offset(0, 9).Value = Sheets(2).Range("D7") 'invullen gebeld Ja/Nee

ElseIf Sheets(2).Range("D4", "D5") Is Not Empty Then
Rng.Offset(0, 6).Value = Sheets(2).Range("D4")  'invullen status
Rng.Offset(0, 7).Value = Sheets(2).Range("D5") 'invullen negatief

ElseIf Sheets(2).Range("D4", "D6") Is Not Empty Then
Rng.Offset(0, 6).Value = Sheets(2).Range("D4")  'invullen status
Rng.Offset(0, 7).Value = Sheets(2).Range("D6") 'invullen positief

Else
Rng.Offset(0, 6).Value = Sheets(2).Range("D4")  'invullen status
          End If
        End With
For Each ClearForm In Range("D3:D7")
ClearForm = "" 'Waarde op null zetten.
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("D4").Value = "2" Then
Rows("5:5").EntireRow.Hidden = False
Rows("6:6").EntireRow.Hidden = True
ElseIf Range("D4").Value = "3" Then
Rows("6:6").EntireRow.Hidden = False
Rows("5:5").EntireRow.Hidden = True
Else
Rows("5:6").EntireRow.Hidden = True
End If


End Sub


Graag hoor ik van jullie of jullie een eventuele oplossing hebben.

Mvg

Robert
 

Bijlagen

Laatst bewerkt:
Aan een bestandje met gegevens hebben we meer dan alleen maar de code; je wilt het tenslotte uit kunnen testen.
 
Dag Robert09 !

Om echt te begrijpen wat je wil, moet ik je code grondiger analyseren, maar wat onmiddellijk in het oog springt (misschien toevallig, maar dat geeft niet), is dat je iets wil opzoeken in sheet(3), terwijl er slechts 2 sheets in je bestand zitten.
Code: 
Sub Find_First()
    Dim ClearForm As Range 'Range selecteren voor leegmaken van blad 2
    Dim Rng As Range
    Rows.EntireRow.Hidden = False
    If MsgBox("Wil je doorgaan?", vbOKCancel, "Mijn titel") = vbCancel Then Exit Sub 'MessageBox met de vraag of je door wilt gaan ja/nee
            With [COLOR="#FF0000"]Sheets(3)[/COLOR].Range("C:C")
            Set Rng = .Find(What:=Sheets(2).Range("D3"), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
Het lijkt mij beter om sheets te refereren aan de hand van hun naam in plaats van aan hun volgnummer. Bijvoorbeeld:
Code: 
With Sheets([COLOR="#FF0000"]"Gegevens"[/COLOR]).Range("C:C")
Grtz,
MDN111.
 
Hallo MDN111,

Ik heb het eerste sheet in dit bestand verwijderd omdat het niet relevant voor de vraag was.
Mijn fout, maar ook wanneer ik er blad voor heb krijg ik het niet goed voor elkaar.

Ik zal het complete bestand mee sturen.Bekijk bijlage Garantieformulier Versie 3.xlsm

Hopelijk kunt u mij hiermee verder helpen

Met vriendelijke groeten,

Robert
 
Dag Robert09 !

Blijkbaar werkt het nu wel. Ik heb je laatst bijgevoegde bestand even getest zonder iets aan de code te wijzigen en de drie gegevens uit de sheet "User module" worden overgebracht naar de betreffende regel van sheet "Gegevens".

Grtz,
MDN111.
 
Hallo MDN111,

Dat werkt ook wel alleen ik wil dat de verborgen rijen niet worden meegenomen naar het 3e sheet.
Wanneer status 2 wordt in gevuld word een negatieve order ingevuld en deze moet dan worden meegenomen.
Wanneer status 3 wordt in gevuld word een positieve order ingevuld en moet deze worden meegenenomen.

Wanneer er de (verborgen) cel geen waarde bevat mag deze ook niet in het 3e sheet worden meegenomen.
Wanneer nu een 3e status wordt ingevuld word de negatieve order overschreven door een lege cel.

Graag hoor ik of je hier een oplossing voor hebt.

Met vriendelijke groet,

Robert
 
Dag Robert09 !

Probeer deze code eens:
Code: 
Rng.Offset(0, 6).Value = Sheets(2).Range("D4")  'invullen status
[COLOR="#FF0000"]If Sheets(2).Range("D5").EntireRow.Hidden = False Then[/COLOR]
    Rng.Offset(0, 7).Value = Sheets(2).Range("D5") 'invullen negatief
[COLOR="#FF0000"]End If[/COLOR]
[COLOR="#FF0000"]If Sheets(2).Range("D6").EntireRow.Hidden = False Then[/COLOR]
    Rng.Offset(0, 8).Value = Sheets(2).Range("D6") 'invullen positief
[COLOR="#FF0000"]End If[/COLOR]
Rng.Offset(0, 9).Value = Sheets(2).Range("D7") 'invullen gebeld Ja/Nee
Grtz,
MDN111.
 
Hallo MDN111,

Super de negatieve en positieve waardes gaan nu goed, hiervoor hartelijk dank!!.

Nu zit ik alleen nog met de ja/nee waarde in D7, deze wordt ook overschreven wanneer er niks is ingevuld.
Is het mogelijk om bijvoorbeeld
Code: 
if Range("D7") is not null then '.... uitvoer code.

Ik heb van alles geprobeerd maar ik loop elke keer vast op statement op de waarde.

Ik hoor graag van u,

Met vriendelijke groet,

Robert
 
Hallo MDN111,

Ik heb het al opgelost.
De volgende code heb ik gebruikt:
Code: 
If Sheets(2).Range("d7").Value >= 1 Then
Rng.Offset(0, 9).Value = Sheets(2).Range("D7") 'invullen gebeld Ja/Nee
End If

Mijn dank is groot!

Met vriendelijke groet,

Robert
 
Nogmaals dag Robert09 !

Het is niet aan mij om te zeggen wat jij moet of niet moet doen, maar ik zou mij niet echt comfortabel voelen bij die laatste oplossing. Je vergelijkt in feite een string ("Ja" of "Nee") met een numerieke waarde. Het werkt blijkbaar wel, maar toch... Persoonlijk zou ik de volgende code gebruiken:
Code: 
[COLOR="#FF0000"]If Not IsEmpty(Sheets(2).Range("D7")) Then[/COLOR]
    Rng.Offset(0, 9).Value = Sheets(2).Range("D7") 'invullen gebeld Ja/Nee
End If

Omdat ik wel wat geïntrigeerd was door die string/nummer vergelijking, was ik daar wat mee aan 't stoeien en toen ben ik op nog iets anders gestuit: Als je klikt op de "Doorvoeren status" knop en er is geen Garantie-nummer ingevuld, dan worden de waarden uit de User module overgebracht naar de laatste regel van de gegevens-sheet, en het garantienummer blijft dan leeg (dat komt omdat je dan een nulwaarde opzoekt in de kolom van de garantienummers). Dat kan je vermijden door de Sub te beëindigen als het Garantie-nummer leeg is, door bijvoorbeeld de volgende code:
Code: 
Sub Find_First()
    Dim FindString As Integer
    Dim ClearForm As Range 'Range selecteren voor leegmaken van blad 2
    Dim Rng As Range
    
   [COLOR="#FF0000"] If IsEmpty(Sheets(2).Range("D3")) Then
        MsgBox "Geen garantie-nummer ingevuld"
        Exit Sub
    End If[/COLOR]
    
    If MsgBox("Wil je doorgaan?", vbOKCancel, "Mijn titel") = vbCancel Then Exit Sub 'MessageBox met de vraag of je door wilt gaan ja/nee
            With Sheets(3).Range("C:C")
            Set Rng = .Find(What:=Sheets(2).Range("D3"), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

Grtz,
MDN111.
 
Laatst bewerkt:
Hallo MDN111,

Super bedankt voor de tips!
Ik was allang blij met een werkende functie!

Heb beide aanpassingen doorgevoerd en het werkt fantastisch!
Weer een hoop geleerd tijdens dit projectje, op naar de volgende!

Met vriendelijke groeten,

Robert
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan