Regel verwijderen met VBA

[hoogteijling]

Hallo allemaal,

In bijgevoegd bestand is een knop (Project verwijderen) die ervoor zorgt dat er een regel verwijderd wordt en dat de resterende regels gesorteerd worden.
Wat ik nu zou willen is dat deze knop een regel verwijderd maar daarna niet sorteert.

Uiteraard mag er geen lege regel overblijven tussen de overgebleven regels.

Groeten Marcel
Bekijk bijlage Projectenboek.zip

 

[exhelp]

Hallo,

Dan hoef je toch enkel de VBA code voor het sorteren te verwijderen?
Of zie ik dat verkeerd?

Mvg
Exhelp

 

[hoogteijling]

Dan blijft er dus een lege regel over in de lijst met projectnummers.
Dat wil ik dus niet.

Groeten Marcel

 

[exhelp]

Zo dan?

Private Sub CommandButton3_Click() '<= Project verwijderen button in Uform
    If MsgBox("Project definitief verwijderen ??", vbQuestion + vbOKCancel, "Project verwijderen") = vbOK Then
        Application.ScreenUpdating = False
        With Sheets("Projectenboek")
            '.Cells(.Columns(3).Find(ComboBox1.Value, , xlValues, xlWhole).Row, 3).Offset(, -1).Resize(, 9).ClearContents
            .Cells(.Columns(3).Find(ComboBox1.Value, , xlValues, xlWhole).Row, 3).Offset(, -1).Resize(, 9).EntireRow.Delete
            '.Sort.SortFields.Clear
            '.Sort.SortFields.Add Key:=Range("C1:C" & .Cells(Rows.Count, 3) _
            '        .End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending
            'With .Sort
            '    .SetRange Range("B1:J" & Sheets("Projectenboek") _
            '            .Cells(Rows.Count, 2).End(xlUp).Row)
            '    .Header = xlYes
            '    .Apply
            'End With
        End With
    Else
    End If
    proj_verw.Hide
    Unload Me
    Application.ScreenUpdating = True
End Sub

 

[hoogteijling]

Er komt een foutmelding te staan:

Fout 1004 tijdens uitvoering:
Methode Delete van klasse Range is mislukt.

Groeten Marcel

 

[Cobbejaan]

Deze zal dat wel doen:

Private Sub CommandButton3_Click() '<= Project verwijderen button in Uform
    If MsgBox("Project definitief verwijderen ??", vbQuestion + vbOKCancel, "Project verwijderen") = vbOK Then
        Application.ScreenUpdating = False
        With Sheets("Projectenboek")
           Set c = .Cells(.Columns(3).Find(ComboBox1.Value, , xlValues, xlWhole).Row, 3).Offset(, -1).Resize(, 9)
            .Rows(c.Row).Delete
        End With
    Else
    End If
    proj_verw.Hide
    Unload Me
    Application.ScreenUpdating = True
End Sub

 

[snb]

Als Giga Senior weet je toch wel hoe je een lege rij kunt verwijderen met VBA ?

 

[exhelp]

Tja, dat heb je dan met code 'uit de losse pols'.
Goed dat cobbejaan dit snel heeft verbeterd.

Kijk ook eens hier:

Rijen verwijderen op basis van een bepaalde celwaarde (VBA)

 

[hoogteijling]

@snb,

VBA blijft erg lastig voor mij

Groeten Marcel

 

[hoogteijling]

Foutmelding verschijnt nog steeds

Groeten Marcel

 

[hoogteijling]

De foutmelding komt alleen als de beveiliging aan staat.
Het daadwerkelijke bestand is nl beveiligd.
Hoe kan ik dit verhelpen ?

Het bestand wat ik gepost heb in POST#1 is namelijk een uitgeklede versie.

Groeten Marcel

 

[Cobbejaan]

Private Sub CommandButton3_Click() '<= Project verwijderen button in Uform
    If MsgBox("Project definitief verwijderen ??", vbQuestion + vbOKCancel, "Project verwijderen") = vbOK Then
    With Application
         .ScreenUpdating = False
         .Unprotect
        With Sheets("Projectenboek")
           Set c = .Cells(.Columns(3).Find(ComboBox1.Value, , xlValues, xlWhole).Row, 3).Offset(, -1).Resize(, 9)
            .Rows(c.Row).Delete
        End With
    Else
    End If
    proj_verw.Hide
    Unload Me
        .ScreenUpdating = True
        .Protect
  End with
End Sub

Misschien nog een paswoord toevoegen.

 

[snb]

Heel leesbaar:

http://www.amazon.com/Mastering-VBA...A_1_21?s=books&ie=UTF8&qid=1389268832&sr=1-21

 

[hoogteijling]

Wat ik zo vreemd vind is dat het voorheen (met sorteerfunctie) wel werkte en nu zonder sorteerfunctie niet meer.
Terwijl toen ook de beveiliging aan stond bij mij.

Groeten Marcel

 

[hoogteijling]

@Cobbejaan

Foutmelding: Else zonder If verschijnt nu.

Groeten Marcel

 

[hoogteijling]

Onderstaande code werkt totdat ik het werkblad beveilig en de .Protect en .Unprotect regels actief maak (geen wachtwoord).

Private Sub CommandButton3_Click() '<= Project verwijderen button in Uform
    If MsgBox("Project definitief verwijderen ??", vbQuestion + vbOKCancel, "Project verwijderen") = vbOK Then
        With Application
'        .Unprotect
        ScreenUpdating = False
                End With
        With Sheets("Projectenboek")
           Set c = .Cells(.Columns(3).Find(ComboBox1.Value, , xlValues, xlWhole).Row, 3).Offset(, -1).Resize(, 9)
            .Rows(c.Row).Delete
        End With
    Else
    End If
    proj_verw.Hide
    Unload Me
    With Application
    ScreenUpdating = True
'    .Protect
    End With
End Sub

Kan iemand nog eventjes helpen

Groeten Marcel

 

[hoogteijling]

Iemand nog ideeën ?

Groeten Marcel

 

[Cobbe]

Test hem zo eens:

Private Sub CommandButton3_Click() '<= Project verwijderen button in Uform
  If MsgBox("Project definitief verwijderen ??", vbQuestion + vbOKCancel, "Project verwijderen") = vbOK Then
   With Sheets("Projectenboek")
        .Unprotect
    With Application
         .ScreenUpdating = False
           Set c = .Cells(.Columns(3).Find(ComboBox1.Value, , xlValues, xlWhole).Row, 3).Offset(, -1).Resize(, 9)
            .Rows(c.Row).Delete
      proj_verw.Hide
   Unload Me
        .ScreenUpdating = True
        .Protect
  End With
  End With
 End If
End Sub

 

[hoogteijling]

Bedankt Cobbe,

Private Sub CommandButton3_Click() '<= Project verwijderen button in Uform
  If MsgBox("Project definitief verwijderen ??", vbQuestion + vbOKCancel, "Project verwijderen") = vbOK Then
   With Sheets("Projectenboek")
        .Unprotect
    With Application
         .ScreenUpdating = False
           Set c = .Cells(.Columns(3).Find(ComboBox1.Value, , xlValues, xlWhole).Row, 3).Offset(, -1).Resize(, 9)
            .Rows(c.Row).Delete
      proj_verw.Hide
   Unload Me
        .ScreenUpdating = True
[COLOR="#FF0000"]        .Protect
  End With[/COLOR]
  End With
 End If
End Sub

Na het omwisselen van de rode regels werkt ie uitstekend.

Groeten Marcel