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

Hoe 2 macro codes samen voegen

Status
Niet open voor verdere reacties.

davylenders123

Gebruiker
Lid geworden
20 jun 2010
Berichten
902
Deze code hieronder doet het volgende.
Als je vanaf rij 34 en naam ingeeft gaat hij zoeken of dat hij die naam ergens vind en als hij die vind verwijderd hij die uit het bestand.

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i, j, iWS As Integer
  For i = 3 To 33
  For j = 1 To 7
    On Error Resume Next
    If ActiveSheet.Index <= 3 And Target.Row > 33 Then
        For iWS = 1 To 3
            Worksheets(iWS).Cells(i, j).Find(Target, , xlValues, xlWhole).Value = ""
        Next
      End If
    Next j
  Next i
End Sub

Deze code hieronder heeft hier iemand voor mij gemaakt om wijzigingen bij te houden in een apart tab blad (logfile)


Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next

If Not Sh.Name = "Logfile" Then bChange = True
If ActiveSheet.Name <> "Logfile" And bNWrd = False And Target.Count = 1 Then
    If Target.HasFormula Then
        sNWrd = Target.Formula
    Else
        bNWrd = True
        sNWrd = Target.Value
        If sNWrd = ActiveSheet.Name Then sNWrd = ""
    End If
    invullen
End If
End Sub

Deze 2 codes zouden eigenlijk alle 2 in het zelfde excel bestandje moeten werken maar 2 keer een "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
" in this workbook zetten werkt niet.

Wat moet er veranderen dat deze 2 codes alle 2 werken.
 
Als beide codes werkten dan zullen ze zo ook wel werken zeker.

Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i, j, iWS As Integer
  For i = 3 To 33
  For j = 1 To 7
    On Error Resume Next
    If ActiveSheet.Index <= 3 And Target.Row > 33 Then
        For iWS = 1 To 3
            Worksheets(iWS).Cells(i, j).Find(Target, , xlValues, xlWhole).Value = ""
        Next
      End If
    Next j
  Next i

On Error Resume Next

If Not Sh.Name = "Logfile" Then bChange = True
If ActiveSheet.Name <> "Logfile" And bNWrd = False And Target.Count = 1 Then
    If Target.HasFormula Then
        sNWrd = Target.Formula
    Else
        bNWrd = True
        sNWrd = Target.Value
        If sNWrd = ActiveSheet.Name Then sNWrd = ""
    End If
    invullen
End If
End Sub
 
Cobbe

B E D A N K T :thumb:

Het werkt inderdaad zo met u code.

Ik ben helemaal niet goed met vba en had zelf al wat geprobeerd maar dan deed de eerste code niet helemaal wat hij moest doen.:o
Daarom had ik het hier even gevraagd omdat ik weet dat hier van die kraken zitten zoals jij.:):thumb:
 
Cobbe Of andere helpende handen,

Het probleem dat ik had is blijkbaar nog niet verholpen.
In het bestand worden eigenlijk onderaan eerst de zieken en verloven ingevuld door hun naam daar te type in de cellen b35-b40 c35-c40 d35-d40.
Dan gaat hij zoeken of die naam er staat en verwijderd die naam.
Dan wordt het bestand opgeslagen.
Tot hier geen enkel probleem.

Dan wordt het bestand terug open gedaan en worden er bepaald namen verzet van plaats.
Als je een 3 a 4 tal namen hebt verzet dan gaat hij weer zoeken en de namen terug verwijderen.
Dit zou niet mogen.
Hij mag enkel namen verwijderen dat ze in de cellen b35-b40 c35-c40 d35-d40 worden gezet.
Maar nu zoekt hij ook als je in de andere cellen een naam zet bv b 5.

Het rare is dat hij het niet heeft voor je het bestand 1 keer hebt gewijzigd en hebt opgeslagen.

Dit bestandje is het origineel
Bekijk bijlage sorteer planning1.rar

Dit bestandje daar zijn de verloven en zieken al ingevuld en dus al 1 keer opgeslagen .

Bekijk bijlage sorteer planning1.rar

Ps Wordt er in het bestandje ergens een wachtwoord gevraagd is dat "helpmij" (wel zonder haakjes.)
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan