Cursor naar volgende regel kolom C

Robert Smidt · 18 dec 2016

Beste Helpmij'ers,

Ik beschik over een code die vanaf kolom I naar de volgende regel naar kolom 3 gaat nl.

Code:

Application.Goto .Offset(1, -6)

Dat werkt perfect wanneer je in kolom I staat, maar wanneer ik in een andere kolom sta treedt bovenstaande code ook in werking en gaat de cursor naar een andere kolom en dus niet wenselijk. Wie kan mij helpen met een code dat bovenstaande code pas in werking gaat wanneer ik in kolom I sta?

Alvast heel erg bedankt.

Robert

edmoor · 18 dec 2016

Je laat alleen de regel zien die de cursor verplaatst en de rest van de Sub niet. En daar gaat het nu net om.
Maar probeer dit eens:

Code:

If Target.Column = 9 Then
    Application.Goto .Offset(1, -6)
End If

Dat zal echter alleen werken als je in die Sub het object Target voorhanden hebt.

Robert Smidt · 18 dec 2016

Bedankt voor jouw snelle reactie, maar ik heb target niet opgenomen in de code. De totale code is inmiddels zo groot dat ik jou dat niet aan wil doen. Ik kan je wel de specifieke code geven waar deze regel in staat.

Code:

        If Range("h" & Target.Row) = [Btwhoogtarief].Value Then
            
                If Range("J" & Target.Row) = "" Then
                    'Cells(Target.Row, 9).Resize(, 4).ClearContents
                     Cells(Target.Row, 9).Resize(, 1).ClearContents '9 = I
                      Cells(Target.Row, 11).Resize(, 2).ClearContents '11 = k
                End If
                 
            'Btw-bedrag berekenen incl. btw-prijs
             If Range("I" & Target.Row) <> "" Then
                Cells(Target.Row, 10).Resize(, 3).ClearContents
                Range("k" & Target.Row) = ((Range("I" & Target.Row) / [Btwhoogformule].Value) * (100 * (Range("H" & Target.Row))))
                Range("J" & Target.Row) = ((Range("I" & Target.Row) / [Btwhoogformule].Value) * 100)
                
                Application.Goto .Offset(1, -6)

            End If
                        
           'Btw-bedrag berekenen excl btw-prijs
            If Range("J" & Target.Row) <> "" And Range("I" & Target.Row) = "" Then
                Range("K" & Target.Row) = (Range("J" & Target.Row) * (Range("H" & Target.Row)))
                Range("I" & Target.Row) = (Range("J" & Target.Row) + (Range("K" & Target.Row) + (Range("L" & Target.Row))))
                Range("K" & Target.Row) = (Range("i" & Target.Row) - (Range("j" & Target.Row)))
                Application.Goto .Offset(1, -7)
            End If
          End If

edmoor · 18 dec 2016

Ik zie nog steeds de regel met Sub niet. Wel zie ik dat je wel degelijk het object Target gebruikt.

Robert Smidt · 18 dec 2016

sorry, ik stuur je de hele code

Code:

'U I T G A V E N
'Versie 2.0
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

If Not Intersect(Target, Range("a13:y500")) Is Nothing Then
    If Selection.Count = 1 Then
    If Not Intersect(Target, Union(Columns(1), Columns(2), Columns(3), Columns(4), Columns(5), Columns(6), Columns(7), Columns(8), Columns(9), Columns(10), Columns(11), Columns(12), Columns(13), Columns(14), Columns(15), Columns(18), Columns(23), Columns(32))) Is Nothing Then
        With Target

        'If .Column = 1 And Not IsEmpty(Target) Then Application.Goto .Offset(, 2) 'kolom a
        'If .Column = 2 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom b
        If .Column = 3 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom c
        If .Column = 4 And Not IsEmpty(Target) Then Application.Goto .Offset(, 2) 'kolom d
        If .Column = 5 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom e
        If .Column = 6 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom f
        If .Column = 7 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom g
        If .Column = 8 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom h
        If .Column = 9 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom I
        If .Column = 10 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom J
        If .Column = 11 And Not IsEmpty(Target) Then Application.Goto .Offset(, 1) 'kolom K

        'Cellen beginnen hoofdletter
        [C13:c500] = [index(proper(C13:F500),)]
        
        'Datum
         If Range("a" & Target.Row) = "" And Range("c" & Target.Row) <> "" Then '
            Range("a" & Target.Row) = Date
        End If
        
        
        'Boeknummer ophogen uitgaven
        If Range("a" & Target.Row) <> "" And Range("b" & Target.Row) = "" And Range("i" & Target.Row) > 0 Then '
            Range("b" & Target.Row) = [BoeknummerU] 'U
        End If
        
        If Range("a" & Target.Row) <> "" And Range("b" & Target.Row) = "" And Range("i" & Target.Row) < 0 Then
            Range("b" & Target.Row) = [BoeknummerCRU] 'CRU
        End If
                
       'Kopieren van de formules t.b.v. de openstaande crediteuren!
        If Range("g" & Target.Row) <> "" And Range("q" & Target.Row) = "" Then 'Range("Q" & Target.Row) = Range("Q5").Value
            rij = 0 + ActiveCell.Row
           Range("q5:t5").Select
           Selection.Copy
           Cells(rij, 17).Select
           ActiveSheet.Paste
          ' Cells(rij, 2).Select
        
           rij = 0 + ActiveCell.Row
           Range("v5:ab5").Select
           Selection.Copy
           Cells(rij, 22).Select
           ActiveSheet.Paste
           
           rij = 0 + ActiveCell.Row
           Range("h5").Select
           Selection.Copy
           Cells(rij, 8).Select
           ActiveSheet.Paste
        
        Application.Goto .Offset(, 2) 'ga naar kolom i
        End If
        
       'Kasverschillen
       If Range("F" & Target.Row) = "Kasverschillen" And Range("G" & Target.Row) = "" Then 'And Range("H" & Target.Row) = ""
            Range("g" & Target.Row) = "Kas"
            Range("H" & Target.Row) = "n.v.t."
            CreateObject("WScript.Shell").Popup "Kasverschillen gebruik je uitsluitend bij een klein kasverschil, bij een groot verschil ga naar INTERNE OVERBOEKING en kies voor Privé(opname)!", 10, "Waarschuwing: Je hoeft niet op OK te klikken", vbCritical
            Application.Goto .Offset(, 3)
        End If
        
        If Range("F" & Target.Row) = "Kasverschillen" And Range("G" & Target.Row) <> "" Then
            Range("M" & Target.Row) = Range("I" & Target.Row)
        End If
        
       'Bankverschillen
       If Range("F" & Target.Row) = "Bankverschillen" And Range("G" & Target.Row) = "" Then 'And Range("H" & Target.Row) = ""
           Range("g" & Target.Row) = "Bank"
           Range("H" & Target.Row) = "n.v.t."
           CreateObject("WScript.Shell").Popup "Bankverschillen gebruik je uitsluitend bij een klein bankverschil, bij een groot verschil ga naar INTERNE OVERBOEKING en kies voor Privé(opname)!", 10, "Waarschuwing: Je hoeft niet op OK te klikken", vbCritical
           Application.Goto .Offset(, 3)
       End If

        
        If Range("F" & Target.Row) = "Bankverschillen" And Range("G" & Target.Row) <> "" Then
            Range("M" & Target.Row) = Range("I" & Target.Row)
        End If
  

'B T W  H O O G  B E R E K E N E N
        If Range("h" & Target.Row) = [Btwhoogtarief].Value Then
            
                If Range("j" & Target.Row) = "" And Range("i" & Target.Row) = "" Then
                    'Cells(Target.Row, 9).Resize(, 4).ClearContents
                     Cells(Target.Row, 9).Resize(, 1).ClearContents '9 = I
                      Cells(Target.Row, 11).Resize(, 2).ClearContents '11 = k
                End If
                 
            'Btw-bedrag berekenen incl. btw-prijs
             If Range("I" & Target.Row) <> "" Then
                Cells(Target.Row, 10).Resize(, 3).ClearContents
                Range("k" & Target.Row) = ((Range("I" & Target.Row) / [Btwhoogformule].Value) * (100 * (Range("H" & Target.Row))))
                Range("J" & Target.Row) = ((Range("I" & Target.Row) / [Btwhoogformule].Value) * 100)
                
If Target.Column = 9 Then
    Application.Goto .Offset(1, -6)
End If
            End If
                        
           'Btw-bedrag berekenen excl btw-prijs
            If Range("J" & Target.Row) <> "" And Range("I" & Target.Row) = "" Then
                Range("K" & Target.Row) = (Range("J" & Target.Row) * (Range("H" & Target.Row)))
                Range("I" & Target.Row) = (Range("J" & Target.Row) + (Range("K" & Target.Row) + (Range("L" & Target.Row))))
                Range("K" & Target.Row) = (Range("i" & Target.Row) - (Range("j" & Target.Row)))
                Application.Goto .Offset(1, -7)
            End If
          End If
        
'B T W  L A A G  B E R E K E N E N
         If Range("h" & Target.Row) = [Btwlaagtarief].Value Then
            
                If Range("J" & Target.Row) = "" Then
                    'Cells(Target.Row, 9).Resize(, 4).ClearContents
                     Cells(Target.Row, 9).Resize(, 1).ClearContents '9 = I
                      Cells(Target.Row, 11).Resize(, 2).ClearContents '11 = k
                End If
                            
             'Btw-bedrag berekenen incl. btw-prijs
            If Range("I" & Target.Row) <> "" Then
                Cells(Target.Row, 10).Resize(, 3).ClearContents '10 = J
                Range("L" & Target.Row) = ((Range("I" & Target.Row) / [Btwlaagformule].Value) * (100 * (Range("H" & Target.Row))))
                Range("J" & Target.Row) = ((Range("I" & Target.Row) / [Btwlaagformule].Value) * 100) 'net gewijzigd
                Application.Goto .Offset(1, -6)
            End If
                        
            'Btw-bedrag berekenen excl btw-prijs
            If Range("J" & Target.Row) <> "" And Range("I" & Target.Row) = "" Then
                Range("L" & Target.Row) = (Range("J" & Target.Row) * (Range("H" & Target.Row)))
                Range("I" & Target.Row) = (Range("J" & Target.Row) + (Range("L" & Target.Row)))
                Range("L" & Target.Row) = (Range("i" & Target.Row) - (Range("j" & Target.Row))) 'net gewijzigd
                Application.Goto .Offset(1, -7)
            End If
         End If

    
'B T W  O V E R I G  B E R E K E N E N
        If Range("h" & Target.Row) = "Geen" Or Range("h" & Target.Row) = "n.v.t." Or Range("h" & Target.Row) = "Marge" Or Range("h" & Target.Row) = "Vrijgesteld" Or Range("h" & Target.Row) = "Verlegd" Or Range("h" & Target.Row) = "Binnen EU" Or Range("h" & Target.Row) = "Buiten EU" Then
            Cells(Target.Row, 10).Resize(, 3).ClearContents
            If Range("I" & Target.Row) <> "" And Range("J" & Target.Row) = "" Then
                Range("J" & Target.Row) = Range("I" & Target.Row)
            End If
        End If
    
        If Range("h" & Target.Row) = "Geen" Or Range("h" & Target.Row) = "n.v.t." Or Range("h" & Target.Row) = "Marge" Or Range("h" & Target.Row) = "Vrijgesteld" Or Range("h" & Target.Row) = "Verlegd" Or Range("h" & Target.Row) = "Binnen EU" Then
            If Range("J" & Target.Row) <> "" And Range("I" & Target.Row) = "" Then
                Range("I" & Target.Row) = Range("J" & Target.Row)
            End If
        End If

        '21% / 6% beide tarieven van toepassing
        If Range("H" & Target.Row) = "21% / 6%" And Range("I" & Target.Row) = "" Then CreateObject("WScript.Shell").Popup "Bereken zelf de beide btw-bedragen", 20, "Waarschuwing: Je hoeft niet op OK te klikken", vbCritical
        If Range("H" & Target.Row) = "21% / 6%" And Range("I" & Target.Row) = "" Then Cells(Target.Row, 9).Resize(, 4).ClearContents 'kolom en aantal cellen legen
        
        'Foutieve keuze voldaan per:
        If Range("G" & Target.Row) = "Op rekening" Or Range("G" & Target.Row) = "n.v.t." Or Range("G" & Target.Row) = "" Then Cells(Target.Row, 13).Resize(, 4).ClearContents

        'Wanneer het ex-btw-bedrag en de btw-bedragen niet gelijk zijn aan het incl. btw-bedrag
        If Range("I" & Target.Row) <> "" And Range("J" & Target.Row) <> "" Then
            If Range("K" & Target.Row) <> "" Or Range("L" & Target.Row) <> "" Then
                If Range("I" & Target.Row) <> Range("j" & Target.Row) + Range("k" & Target.Row) + Range("l" & Target.Row) Then CreateObject("WScript.Shell").Popup "Er zit een fout in één van de bedragen of de kolom (BTW laag tarief) is nog niet (juist) gevuld, herstel eerst de fout!                                                  OPMERKING: hierna volgt nog een foutmelding, deze blijft zolang de fout niet is hersteld", 20, "Waarschuwing: Je hoeft niet op OK te klikken", vbCritical
            End If
        End If

'CREDITEUREN (de betaling is verricht)

If Range("F" & Target.Row) <> "Bankverschillen" And Range("F" & Target.Row) <> "Kasverschillen" Then
    If Range("G" & Target.Row) <> "Op rekening" And Range("G" & Target.Row) <> "Vooruitbetaald" And Range("G" & Target.Row) <> "Nog te betalen" And Range("G" & Target.Row) <> "n.v.t." And Range("G" & Target.Row) <> "" And Range("i" & Target.Row) <> "" And Range("N" & Target.Row) = "" Then
        Select Case MsgBox("Het betaalde bedrag is " & "€ " & Range("i" & Target.Row) & ".  Is dit bedrag correct?", vbYesNo, "BETALINGSMUTATIE")
        Case vbYes
            Range("m" & Target.Row) = Range("I" & Target.Row).Value
        Case vbNo
            Range("m" & Target.Row).Value = InputBox("Hoeveel heeft u betaald?", "BETALINGSMUTATIE  (Let op! zet een punt i.p.v. een komma)")
        End Select
        
        datum = InputBox("Betaaldatum dd-mm-jjjj", , Format(Range("a" & Target.Row), "dd-mm-yyyy"))
        If Trim(datum) <> "" Then
            If IsDate(datum) Then Range("N" & Target.Row) = CDate(datum)
        End If
        Application.Goto .Offset(, 5) 'kolom c
    End If
    
    
    If Range("O" & Target.Row) <> "" And Range("P" & Target.Row) = "" Then
        correctie = MsgBox("Het betaalde bedrag is " & "€ " & Range("i" & Target.Row) - Range("m" & Target.Row) & ".  Is dit bedrag correct?", vbYesNo, "BETALINGSMUTATIE")
        If correctie = vbYes Then
           Range("O" & Target.Row) = Range("I" & Target.Row).Value - Range("M" & Target.Row).Value
        Else: Range("O" & Target.Row).Value = InputBox("Hoeveel heeft u betaald?", "BETALINGSMUTATIE  (Let op! zet een punt i.p.v. een komma)")
        End If
        
        datum = InputBox("Betaaldatum dd-mm-jjjj", , Format(Range("a" & Target.Row), "dd-mm-yyyy"))
        If Trim(datum) <> "" Then
            If IsDate(datum) Then Range("P" & Target.Row) = CDate(datum)
        End If
        Application.Goto .Offset(, -14) 'kolom a
    End If
End If

'Kassaldo is negatief
    If Range("A" & Target.Row) <> "" And Range("C" & Target.Row) = "" Then
        If [Kassaldo] < 0 Then CreateObject("WScript.Shell").Popup "Het kassaldo is negatief hetgeen op een fout berust, herstel eerst deze fout of ga naar INTERNE OVERBOEKING en boek dit als KASVERSCHIL!", 20, "Waarschuwing: Je hoeft niet op OK te klikken", vbCritical
    End If

 'Duurzame bedrijfsmiddelen onjuist als kosten geboekt
    If Not Intersect(Target, Range("i13:i500")) Is Nothing Then
        If Not IsError(Application.Match(Cells(Target.Row, 6), [Duurzamekosten], 0)) And Range("i" & Target.Row) > 545 Then
            CreateObject("WScript.Shell").Popup "Je hebt een bedrijfsmiddel (> €450) als kosten geboekt, dat is niet juist. Ga naar de kolom Catagorie en wijzig deze in een (duurzaam) BEDRIJFSMIDDEL, deze kun je herkennen doordat deze niet eindigt op 'kosten'!", 60, "Waarschuwing: Fout herstellen", vbCritical
            Application.Goto .Offset(, -3)
        End If
    End If

'Niet op duurzaam bedrijfsmiddel afschrijven (zoeken binnen een bereik)
    'If Not IsError(Application.Match(Cells(Target.Row, 6), Sheets("Data").[b161:b175], 0)) And Range("i" & Target.Row) <> "" And Range("J" & Target.Row) < 451 Then
 
    If Not IsError(Application.Match(Cells(Target.Row, 6), [Bedrijfsmiddelenvak], 0)) And Range("i" & Target.Row) <> "" And Range("J" & Target.Row) < 451 Then

        MsgBox "Het betreft hier een duurzaam bedrijfsmiddel met een geringe waarde van minder dan € 450. Boek deze als KOSTEN in de kolom Categorie!"
        Application.Goto .Offset(, -3)
    End If
 
 'Wanneer er een fout zit in het Resultatenoverzicht
    If Range("i" & Target.Row) <> "" And Range("j" & Target.Row) <> "" Then
        If Range("k" & Target.Row) <> "" Or Range("l" & Target.Row) <> "" Then
            If [balansfout] <> 0 Then CreateObject("WScript.Shell").Popup "Er zit een fout in de balansberekening, ga niet verder en meld de fout aan Cashflow-Control!", 10, "Waarschuwing: ", vbCritical
            Sheets("Uitgaven").Select
        End If
    End If

'Op duurzaam bedrijfsmiddel afschrijven (zoeken binnen een bereik)
    'If Not IsError(Application.Match(Cells(Target.Row, 6), Sheets("Data").[b197:b199], 0)) And Range("I" & Target.Row) <> "" Then
    If Not IsError(Application.Match(Cells(Target.Row, 6), [Duurzamebedrijfsmiddelen], 0)) And Range("J" & Target.Row) > 450 Then
        MsgBox "Het betreft hier een duurzaam bedrijfsmiddel waarop afgeschreven moet worden! Het programma leidt je naar het afschrijvingsmenu, vul deze verder in!"

        'Data kopiëren vanuit huidig werkblad naar eerstvolgende (lege) regel werkblad "Afschrijving"!
        Sheets("Afschrijving").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 4).Value = Array _
        (Range("A" & ActiveCell.Row), Range("C" & ActiveCell.Row), Range("F" & ActiveCell.Row), Range("J" & ActiveCell.Row))
        Application.Goto Sheets("Afschrijving").[A1].End(xlDown).Offset(0, 4) 'plaats cursor
    End If

    
    End With
  End If
End If
End If

Application.EnableEvents = True
  

End Sub

edmoor · 18 dec 2016

Als die hele code alleen uitgevoerd moet worden als je in kolom J staat hoef je net onder de Sub maar 1 regeltje te plaatsen. Bijna gelijk aan wat ik al liet zien:

Code:

If Target.Column <> 9 Then Exit Sub

Maar ik denk niet dat dat zo zal zijn.
Je weet nu in ieder geval wat je moet doen.

Robert Smidt · 18 dec 2016

Klopt, het werkt volgens mij perfect. Heel erg bedankt voor jou hulp...

Cursor naar volgende regel kolom C

Robert Smidt

Gebruiker

edmoor

Inventaris

Robert Smidt

Gebruiker

edmoor

Inventaris

Robert Smidt

Gebruiker

edmoor

Inventaris

Robert Smidt

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy