Macro alles wissen met extra's

[Keenny]

Hallo ik ben hier redelijk nieuw maar ik heef het een kans.

In mijn bestand zie je een bestelbon. In het tablad beginscherm zie je dat er nietsis ingevuld,
Geen bestelbon nr, geen leverdatum enzo..
Op het tablad ingevuld zie je hoe dat het ingevuld is (leverdatum kan ik niet invullen want hij heeft telkens een foutmelding, raar maar waar)
Dus wat wil ik nu juist. Men moet altijd meerder bestelbonnen maken dus moet men steeds alles verwijderen van wat dat ingevuld is. nu wil ik ee macro die alle verwijdert zodat het terug is zoals op het BEGINSCHERM.
De rijen met de nummers 13997 enzo die zijn variabel eh. Er kunnen eens 6 rijen zijn of 4 of nog iets anders.

Alvast bedankt en als er vragen zijn shoot!

Bekijk bijlage vraag.xlsx

 

[Emil S]

met deze code kom je wellicht iets verder:

Sub StartLeeg()
Dim Wks As Worksheet
Dim aKoppen As Variant
Dim Rng As Range
Dim lTmp As Long

    'Ini
    Set Wks = Sheets("DIT IS INGEVULD")
    aKoppen = Array("HOMAG", "BAZ")
    
    With Wks
        'cel E6 leeg
        .[e6] = "invullen"
        
        'cellen c7 leeg
        .[c7].MergeArea = "invullen"
        
        'tabellen legen
        For lTmp = UBound(aKoppen) To LBound(aKoppen) Step -1
            Set Rng = .Columns(1).Find( _
                What:=aKoppen(lTmp), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=True)
            
            Set Rng = Rng.Offset(5, 0).CurrentRegion.Columns(1)
            With Rng
                'eerste rij legen
                .Cells(1, 1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents
                If .Cells.Count > 1 Then
                    .Offset(1, 0).Resize(.Cells.Count - 1, 1).EntireRow.Delete
                End If
            End With
        Next
        
    End With
End Sub

 

[Keenny]

Hartelijk dank! Dit is wat ik zocht

 

[Keenny]

met deze code kom je wellicht iets verder:

Sub StartLeeg()
Dim Wks As Worksheet
Dim aKoppen As Variant
Dim Rng As Range
Dim lTmp As Long

    'Ini
    Set Wks = Sheets("DIT IS INGEVULD")
    aKoppen = Array("HOMAG", "BAZ")
    
    With Wks
        'cel E6 leeg
        .[e6] = "invullen"
        
        'cellen c7 leeg
        .[c7].MergeArea = "invullen"
        
        'tabellen legen
        For lTmp = UBound(aKoppen) To LBound(aKoppen) Step -1
            Set Rng = .Columns(1).Find( _
                What:=aKoppen(lTmp), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=True)
            
            Set Rng = Rng.Offset(5, 0).CurrentRegion.Columns(1)
            With Rng
                'eerste rij legen
                .Cells(1, 1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents
                If .Cells.Count > 1 Then
                    .Offset(1, 0).Resize(.Cells.Count - 1, 1).EntireRow.Delete
                End If
            End With
        Next
        
    End With
End Sub

Dag emil S, Je hebt mij fantastisch geholpen maar er zit nog een foutje in denk ik..
Als ik bijvoorbeeld maar 1 getal (16444) ingeef verwijdert hij rijen dat hij niet mag verwijderen
en als ik niets invul mag gij ook die rij niet verwijderen. (bv. als ik bij homag 1 rij invul en bij BAZ niets en heeft gij foutmelding en dat zou niet mogen)

 

[Emil S]

hier een aangepaste code

Sub StartLeeg()
Dim Wks As Worksheet
Dim aKoppen As Variant
Dim Rng As Range
Dim lTmp As Long

    'Ini
    Set Wks = Sheets("DIT IS INGEVULD")
    aKoppen = Array("HOMAG", "BAZ")
    
    With Wks
        'cel E6 leeg
        .[e6] = "invullen"
        
        'cellen c7 leeg
        .[c7].MergeArea = "invullen"
        
        'tabellen legen
        For lTmp = UBound(aKoppen) To LBound(aKoppen) Step -1
            Set Rng = .Columns(1).Find( _
                What:=aKoppen(lTmp), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=True)
            
            Set Rng = Rng.Offset(4, 0).CurrentRegion.Columns(1)
            With Rng
                'eerste rij legen
                On Error Resume Next
                .Cells(1, 1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents
                If .Cells.Count > 1 Then
                    .Offset(1, 0).Resize(.Cells.Count - 1, 1).EntireRow.Delete
                End If
            End With
        Next
        
    End With
End Sub

 

[Keenny]

hier een aangepaste code

Sub StartLeeg()
Dim Wks As Worksheet
Dim aKoppen As Variant
Dim Rng As Range
Dim lTmp As Long

    'Ini
    Set Wks = Sheets("DIT IS INGEVULD")
    aKoppen = Array("HOMAG", "BAZ")
    
    With Wks
        'cel E6 leeg
        .[e6] = "invullen"
        
        'cellen c7 leeg
        .[c7].MergeArea = "invullen"
        
        'tabellen legen
        For lTmp = UBound(aKoppen) To LBound(aKoppen) Step -1
            Set Rng = .Columns(1).Find( _
                What:=aKoppen(lTmp), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=True)
            
            Set Rng = Rng.Offset(4, 0).CurrentRegion.Columns(1)
            With Rng
                'eerste rij legen
                On Error Resume Next
                .Cells(1, 1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents
                If .Cells.Count > 1 Then
                    .Offset(1, 0).Resize(.Cells.Count - 1, 1).EntireRow.Delete
                End If
            End With
        Next
        
    End With
End Sub

Klopt als een bus! Hartelijk bedankt