automatisch lege cel invullen

[Material]

Goedenavond allen,


ik heb even iets waar ik niet uit kom. ik heb van een een bestaande sheet alle formules en de hele mikmak naar een andere sheet gekopieerd.

de formules enz. werken allemaal nog, maar op een paar velden werkt er iets niet en ik kom er niet achter hoe dat komt, want er zit geen formule of macro op.

het gaat om het volgende als ik in een cel bijv. 01-01-2018 invult moet de lege cel ernaast automatisch 01-02-2018 overnemen. en een cel daarnaast moet de datum achterstevoren met een a erachter zetten dus 20180201a.
als ik in de regel erna nog iets op dezelfde datum heb moet het dan 20180201B worden.

in de andere sheet werkt dit automatisch, maar ik zie geen formules op deze cellen staan, dus ik zou niet weten hoe dit werkt.


kan iemand mij de oplossing geven aub .. .

 

[SjonR]

Plaats het bestand eens. Zal toch wel een macro zijn.

 

[Material]

ik heb alleen dit werkblad wat ik je kan laten zien. de rest is met betrouwbare informatie.

in kolom E moet automatisch de datum komen nadat die in D is ingevuld. en in H moet de datum omgekeerd komen met een letter erachter en een andere letter erachter als de volgende regel dezelfde datum bevat.

 

[SjonR]

Bekijk bijlage 323983het gaat er juist om wat er in het werkblad gebeurt wat wel werkt. Het werkblad plaatsen dat niet werkt voegt niet echt iets toe.

Lees anders de tips hieronder even.

 

[Material]

hierbij nog de sheet waarbij het wel werkt. ook moet als de laaddatum op een zaterdag valt zondag overgeslagen worden en bij losdatum op een maandag komen....

 

[SjonR]

Heb je uberhaubt wel gekeken of er iets van VBA in zat? Dit staat in je werkende blad en is toch niet echt over het hoofd te zien. Plak dit achter je andere blad met de VB-editor en je zit volgens mij waar je wil.

'Option Explicit



Private Sub Worksheet_Activate()

LR_DATA = Worksheets("DATA").Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

ThisWorkbook.Names.Add Name:="tempAdressen", RefersTo:=Worksheets("DATA").Range("A3:A" & LR_DATA), Visible:=True
ThisWorkbook.Names.Add Name:="tempTarieven", RefersTo:=Worksheets("DATA").Range("F3:F" & LR_DATA), Visible:=True
            With Range("B7:C1000").Offset(0, 0).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=tempAdressen"
                .IgnoreBlank = False
                .InCellDropdown = True
                .InputTitle = ""
                .InputMessage = ""
                .ErrorTitle = "Invalid Option"
                .ErrorMessage = "Please select from the available options"
                .ShowInput = False
                .ShowError = True
            End With
            With Range("A7:A1000").Offset(0, 0).Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=tempTarieven"
                .IgnoreBlank = False
                .InCellDropdown = True
                .InputTitle = ""
                .InputMessage = ""
                .ErrorTitle = "Invalid Option"
                .ErrorMessage = "Please select from the available options"
                .ShowInput = False
                .ShowError = True
            End With
            
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
Dim sRef As String
Dim iChr As Integer
Dim rCell As Range
Dim iRegel As Integer
iChr = 65


    'Wanneer een wijziging in Kolom 4 (Laaddatum)
    If Target.Column = 4 And IsDate(Target) Then
        iRegel = Target.Row
        'Genereer een voorgestelde code voor transportlijsten
        
     
beginopnieuw:
        For Each rCell In Range("H7:H" & iRegel)
            If rCell.Value = sRef Then
                iChr = iChr + 1
                sRef = Format(Target, "YYMMDD") & Chr(iChr)
             GoTo beginopnieuw
            End If
        Next
        
        Target.Cells(1, 5).Value = sRef
    
        'Als de vertrek dag op Zaterdag staat dan leverdag +2 dagen, anders +1 dag.
        If Weekday(Target, vbMonday) = 6 Then
            Target.Cells(1, 2).Value = Target.Value + 2
        Else
            Target.Cells(1, 2).Value = Target.Value + 1
        End If
    End If
End Sub

 

[Material]

stom zeg ik zag het net ook ja. totaal overheen gekeken.

thnx man :thumb::thumb:

 

[SjonR]

Kan gebeuren :thumb:

 

[Material]

hoe markeer ik het als opgelost <<< nieuw

 

[trainers]

Ik zou je bestand eerst verwijderen.
M.i. teveel (verborgen) werkbladen met informatie.

Op opgelost zetten: rechts bovenin.

Groeten

 

[Material]

ok is gedaan bedankt voor de snelle hulp.

 

[trainers]

Prima.
Volgende keer een dummy bestand plaatsen waarbij wel de essentie van de vraag duidelijk is doch geen (mogelijk) vertrouwelijke informatie wordt gegeven.
Kost wat werk, weet ik, maar is het alleszins waard.

Groeten

PS: ook voor anderen die zoeken. Nu is het bestand niet meer te vinden en dat is natuurlijk jammer. Met een goede dummy wordt dit voorkomen.