• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBa cellen leeg maken op basis van een waarde

Status
Niet open voor verdere reacties.
W

wouter19883

Nieuwe gebruiker
Lid geworden
21 nov 2020
Berichten
4
Wie kan mijn VBA eenvoudiger maken?

ALS Cel R8 de waarde 21 bevat(uitkomst van een formulle) Maar geld dan ook voor R9, R10 ETC....
dan de cellen"a8,B8,F8,G8,h8,k8,i8" in dezelfde rij leegmaken (niet verwijderen)
Wie o wie heeft een passende VBA code
Alvast enorm bedank!!

Ps onderstaand is nu de code maar ik denk dat het eenvoudiger kan.


Code: 
sheets("Bestellijst").Unprotect "Rietveld19883"
If Range("R8").Value = 21 Then
Sheets("Bestellijst").Unprotect "Rietveld19883"
Range("a8,B8,F8,G8,h8,k8,i8").Value = ""
Range("K8").Activate
Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
End With
 Range("B8").Activate
 Range("h8").Activate
 Sheets("Bestellijst").Protect "Rietveld19883"
 
End If
If Range("R9").Value = 21 Then
Range("a9,B9,F9,G9,h9,K9,I9").Value = ""
 Range("K9").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
Range("B9").Activate
Range("h9").Activate
Sheets("Bestellijst").Protect "Rietveld19883"
End If
If Range("R10").Value = 21 Then
Range("a10,B10,f10,G10,h10,K10,i10").Value = ""
 Range("K10").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Range("B10").Activate
    Range("h10").Activate
 Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R11").Value = 21 Then
Range("a11,B11,f11,G11,h11,K11,i11").Value = ""
 Range("K11").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
Range("B11").Activate
Range("h11").Activate
Sheets("Bestellijst").Protect "Rietveld19883"
End If
If Range("R12").Value = 21 Then
Range("a12,B12,f12,G12,h12,K12,i12").Value = ""
 Range("K12").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
   End With
 Range("B12").Activate
 Range("H12").Activate
 Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R13").Value = 21 Then
Range("a13,B13,f13,G13,h13,K13,i13").Value = ""
 Range("K13").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
   Range("B13").Activate
   Range("h13").Activate
   Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R14").Value = 21 Then
Range("a14,B14,f14,G14,h14,K14,i14").Value = ""
 Range("K14").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Range("B14").Activate
    Range("h14").Activate
    Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R15").Value = 21 Then
Range("a15,B15,f15,G15,h15,K15,i15").Value = ""
 Range("K15").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
 Range("B15").Activate
 Range("h15").Activate
 Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R16").Value = 21 Then
Range("a16,B16,f16,G16,h16,K16,i16").Value = ""
 Range("K16").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
Range("B16").Activate
Range("h16").Activate
Sheets("Bestellijst").Protect "Rietveld19883"
End If
If Range("R17").Value = 21 Then
Range("a17,B17,f17,G17,h17,K17,i17").Value = ""
 Range("K17").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
  Range("B17").Activate
  Range("h17").Activate
  Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R18").Value = 21 Then
Range("a18,B18,f18,G18,h18,K18,i18").Value = ""
 Range("K18").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Range("B18").Activate
    Range("h18").Activate
  Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R19").Value = 21 Then
Range("a19,B19,f19,G19,h19,K19,i19").Value = ""
 Range("K19").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
Range("B19").Activate
Range("h19").Activate
  Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R20").Value = 21 Then
Range("a20,B20,f20,G20,h20,K20,i20").Value = ""
 Range("K20").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
Range("B20").Activate
Range("h20").Activate
  Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R21").Value = 21 Then
Range("a21,B21,f21,G21,h21,K21,i21").Value = ""
 Range("K21").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
Range("B21").Activate
Range("h21").Activate
  Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R22").Value = 21 Then
Range("a22,B22,f22,G22,h22,K22,i22").Value = ""
 Range("K22").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
Range("B22").Activate
Range("h22").Activate
  Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R23").Value = 21 Then
Range("a23,B23,f23,G23,h23,K23,i23").Value = ""
 Range("K23").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
Range("B23").Activate
Range("h23").Activate
  Sheets("Bestellijst").Protect "Rietveld19883"
End If

If Range("R24").Value = 21 Then
Range("a24,B24,f24,G24,h24,K24,i24").Value = ""
 Range("K24").Select
 Sheets("Bestellijst").Unprotect "Rietveld19883"
    Selection.Font.Underline = xlUnderlineStyleNone
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
Range("B24").Activate
Range("h24").Activate
  Sheets("Bestellijst").Protect "Rietveld19883"
End If
 
Laatst bewerkt:
Plaats eerst je code in codetags, zie daarvoor de link in mijn handtekening.
Beter nog plaats je een voorbeeld document.
 
Het wijzigen van een waarde in een cel door een formule triggert geen gebeurtenis (event)
Dus welke cellen zijn in de berekening voor die formule opgenomen die wel handmatig worden gewijzigd?
Vandaar ook mijn opmerking over een voorbeeld documentje.
 
Wat heb je zelf al gemaakt en getest ?
Plaats je vraag niet in verschillende subfora.
 
Laatst bewerkt:
Code: 
Sub delete_cells_row_with_21()
Set check_range = Range("R8:R20")   'Bereik met evt. 21 in de cel
Set delete_range = Union(Range("A1:B1"), Range("F1:i1"), Range("k1"))  'eerste regel van de kolommen waarin gewist gaat worden

For Each cl In check_range
    If cl.Value = 21 Then
        'verschuif delete_range naar de regel waar 21 gevonden is en verwijder inhoud
        delete_range.Offset(cl.Row - 1, 0).ClearContents  'keep formatting or .Clear also deletes formatting
    End If
Next cl
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan