• 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.

Gekozen naam op alle bladen verwijderen

Status
Niet open voor verdere reacties.
W

wieter

Terugkerende gebruiker
Lid geworden
26 jun 2009
Berichten
1.128
Alle codes in onderstaand bestand heb ik gepikt van de specialisten op dit forum.
Met de KNOP Namen op blad1 kan je een naam kiezen die moet verwijderd worden in heel het bestand.
Met de onderstaande code lukt het om de gekozen naam op blad2 te verwijderen.
Code: 
Private Sub CommandButton1_Click() 'Naam wissen
If ComboBox1.Value = "" Then
    MsgBox ("Eerst een naam kiezen in de keuzelijst."), vbCritical, "Fout!"
    ComboBox1.SetFocus
Exit Sub
End If
If MsgBox("LET OP ! De naam: " & ComboBox1.Value & " , wissen uit de lijst? Ben je zeker?", vbQuestion + vbYesNo, "Bevestig Wissen") = vbNo _
Then GoTo oeps
With Sheets(2)
    .Range("A6").Resize(Application.CountA(.Columns(1))).Find(ComboBox1.Value).EntireRow.Delete xlShiftUp
    .Range("A36").EntireRow.Insert
End With
With Sheets(3)
'Naamkeuze in de ComboBox, moet uit alle kolommen op Blad 3 verwijderd worden
    '.Range("A2").Resize(Application.CountA(.Columns(1))).Find(ComboBox1.Value).Delete xlShiftUp
End With
oeps:
Unload Me
End Sub
PROBLEEM: Ook op blad3 moet de gekozen naam uit alle kolommen verwijderd worden.
Ook moet na het verwijderen alles met [xlShiftUp] Bewerkt worden.
Wie Kan dit oplossen?
Grtn Wieter
 

Bijlagen

  • Jaarplanning Horizontaal(1).xlsm
    113 KB · Weergaven: 18
zo iets?
Code: 
Private Sub CommandButton1_Click() 'Naam wissen
If ComboBox1.Value = "" Then
    MsgBox ("Eerst een naam kiezen in de keuzelijst."), vbCritical, "Fout!"
    ComboBox1.SetFocus
Exit Sub
End If
If MsgBox("LET OP ! De naam: " & ComboBox1.Value & " , wissen uit de lijst? Ben je zeker?", vbQuestion + vbYesNo, "Bevestig Wissen") = vbNo _
Then GoTo oeps
With Sheets(2)
    .Range("A6").Resize(Application.CountA(.Columns(1))).Find(ComboBox1.Value).EntireRow.Delete xlShiftUp
    .Range("A36").EntireRow.Insert
End With
[COLOR="#FF0000"]With Sheets(3).Range("A2").CurrentRegion.Offset(1)
    Do
      Set naam = .Find(ComboBox1.Value)
      If naam Is Nothing Then GoTo oeps
      naam.Delete xlShiftUp
    Loop
End With[/COLOR]
oeps:
Unload Me
End Sub
 
Laatst bewerkt:
Bedankt Sylvester,
Echter als ik uw aangepaste code gebruik, worden er meer namen verwijderd, dan die ene gekozen naam.
Als de naam gevonden wordt, wordt de volledige rij verwijderd.
Zie jij een oplossing?
Grtn wieter
 
Laatst bewerkt:
wieter, je hebt iets niet goed gedaan, ik heb jouw procedure vervangen door wat ik gepost heb.
 

Bijlagen

  • Jaarplanning Horizontaal svp.xlsm
    104 KB · Weergaven: 17
Hou het simpul:

Code: 
Private Sub UserForm_Initialize()
  ComboBox1.List = Blad2.Range("A6").CurrentRegion.Resize(, 1).Value
End Sub

Private Sub ComboBox1_Change()
  CommandButton1.Visible = ComboBox1.Value <> ""
End Sub

Private Sub CommandButton1_Click() 'Naam wissen
  Blad2.UsedRange.Replace ComboBox1.Value, ""
End Sub
 
Komt mij bekend voor:d
Op blad3 lijkt me dit wel gemakkelijk.(kan waarschijnlijk nog wel korter.)
Code: 
Private Sub CB_Sorteer_Click()
Application.ScreenUpdating = False
With Sheets(3)
    i = .ListObjects(1).ListRows.Count + 1
    j = .ListObjects(1).ListColumns.Count
        .ListObjects(1).Unlist
    For t = 1 To j
        .Range(Cells(2, t), Cells(i, j)).Sort Cells(2, t), 1, , , , , , 0
    Next

    .ListObjects.Add(xlSrcRange, Range("A1:R" & i), , xlYes).Name = "Tabel1"
    .Range("Tabel1").Interior.Pattern = xlNone
End With
Application.ScreenUpdating = True
End Sub

en dan voor het verwijderen van de namen op blad3
Code: 
Blad3.UsedRange.Replace ComboBox1.Value, ""
Sheets("Blad3").CB_Sorteer = True
 
@Sylvester,
Toch denk ik dat jouw code, de hele rij verwijdert, dus ook de namen in de andere kolommen.

@Albert,
Naar aanleiding van een draadje, dat op het forum gestart was, heb ik als tijdverdrijf, dit bestand gemaakt.
Het is dus heel waarschijnlijk dat er code van U gebruikt is.
p.s. Ik denk dat in uw sorteer-code een foutje zit (Toch als ik ze, met mijn beperkte kennis, toepas in het bestand)
 
Wat gaat er dan fout met sorteren?
Bij mij lijkt het goed te werken.
 
Hallo Albert,
Ik heb jouw procedure toegepast in het bestand.
De sorteer-code is inactief gemaakt, omdat ze telkens een foutmelding gaf.
Misschien zie jij het probleem?
 

Bijlagen

  • Jaarplanning Horizontaal(4).xlsm
    117,4 KB · Weergaven: 10
wieter, ja in der daat, ik zie het gebeuren. hier een kleine aanpassing:
Code: 
Private Sub CommandButton1_Click() 'Naam wissen
If ComboBox1.Value = "" Then
    MsgBox ("Eerst een naam kiezen in de keuzelijst."), vbCritical, "Fout!"
    ComboBox1.SetFocus
Exit Sub
End If
If MsgBox("LET OP ! De naam: " & ComboBox1.Value & " , wissen uit de lijst? Ben je zeker?", vbQuestion + vbYesNo, "Bevestig Wissen") = vbNo _
Then GoTo oeps
With Sheets(2)
    .Range("A6").Resize(Application.CountA(.Columns(1))).Find(ComboBox1.Value).EntireRow.Delete xlShiftUp
    .Range("A36").EntireRow.Insert
End With
With Sheets(3).Range("A2").CurrentRegion.Offset(1)
LaatsteRij = .Cells.Rows.Count
    Do
      Set naam = .Find(ComboBox1.Value)
      If naam Is Nothing Then GoTo oeps
      Set namen = Range(naam, .Cells(LaatsteRij, naam.Column))
      namen.Value = namen.Offset(1).Value
    Loop
End With
oeps:
Unload Me
End Sub
 
@Wieter
Ik heb zelf even moeten zoeken waarom het fout ging.
Doordat je de sorteercode in een aparte module hebt geplaatst ging het mis.
Let goed op de punten!!
Code: 
Sub Sorteer()
Application.ScreenUpdating = False
With Sheets(3)
    i = .ListObjects(1).ListRows.Count + 1
    j = .ListObjects(1).ListColumns.Count
        .ListObjects(1).Unlist
    For t = 1 To j
        .Range(.Cells(2, t), .Cells(i, j)).Sort .Cells(2, t), 1, , , , , , 0
    Next

     .ListObjects.Add(xlSrcRange, .Range("A1:R" & i), , xlYes).Name = "Tabel1"
     .Range("Tabel1").Interior.Pattern = xlNone

End With
Application.ScreenUpdating = True
End Sub
 
@Sylvester, @Albert,
Bedankt beiden voor de bereidwilligheid.
Alles werkt nu perfect.
In de code van Albert, waren de ontbrekende punten de oorzaak.
Stom om er overheen te kijken.
Nogmaals bedankt voor de inzet
 
@ silvester-ponte,
Jouw code werkt ook perfect en is "in mijn ogen " veel beter.:thumb: dan dat geklooi van mij.
Alleen wordt er niet gesorteerd.
Heb je daar ook nog een goede oplossing voor ?
 
Albert, voor excel 365 krijg je deze:
Code: 
Private Sub CommandButton1_Click() 'Naam wissen
Dim Naam As Range, Namen As Range
If ComboBox1.Value = "" Then
    MsgBox ("Eerst een naam kiezen in de keuzelijst."), vbCritical, "Fout!"
    ComboBox1.SetFocus
Exit Sub
End If
If MsgBox("LET OP ! De naam: " & ComboBox1.Value & " , wissen uit de lijst? Ben je zeker?", vbQuestion + vbYesNo, "Bevestig Wissen") = vbNo _
Then GoTo oeps
With Sheets(2)
    .Range("A6").Resize(Application.CountA(.Columns(1))).Find(ComboBox1.Value).EntireRow.Delete xlShiftUp
    .Range("A36").EntireRow.Insert
End With
With Sheets(3).Range("A2").CurrentRegion.Offset(1)
LaatsteRij = .Cells.Rows.Count
    Do
      Set Naam = .Find(ComboBox1.Value)
      If Naam Is Nothing Then GoTo oeps
      Naam = ""
      Set Namen = Intersect(.Cells, Naam.EntireColumn)
      Namen.Value = WorksheetFunction.Sort(Namen)
    Loop
End With
oeps:
Unload Me
End Sub
 
Jammer, ik werk nog met excel2016, kan het dus niet testen.
Is het echter niet zo dat de hele tabel wordt gesorteerd op de kolom waar de laatste Naam wordt gevonden.:confused:
Kan het natuurlijk mis hebben. Daarom had ik eerst de tabel geconverteerd naar een normaal bereik en daarna weer teruggezet.
 
ja, in 365 heb je vele extra handige functies aan het werkblad toegevoegd. daar is sorteren er een van. het is echt een aanrader.

ps de toepassing van een tabel is niet handig in deze opzet .
als je de ene kolom sorteert is de anderen gelijk ongesorteerd.
elke kolom zou eigenlijk een aparte tabel moeten zijn. (unlist) want horizontale binding is in deze toepassing ongewenst
 
Laatst bewerkt:
Da's wel effe slikken die nieuwe spelling van inderdaad.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan