Bij invoer van een aantal in een kolom automatisch 3 velden ernaast invoeren

[cissie1]

Voor mijn werk probeer ik een uitleensysteem te maken. Voor een andere functie ben ik via dit forum al heel erg geholpen (hartelijk dank daarvoor!), maar ik zou graag nog een aanpassing willen.

Ik ben beginnend vba'er en kom er helaas zelf nog niet helemaal uit.
Onderstaande code heb ik geschreven, maar dat werkt niet.

De bedoeling is dat wanneer er een aantal ingevoerd wordt in een kolom aantal, dat automatisch de velden datum ophalen, datum terugbrengen en de naam gekopieerd worden uit de cellen P1, P2 en R1.

Is er iemand die mij kan helpen? Ik heb geen idee of mijn code een beetje lijkt op wat het zou moeten worden...


http://www.mijnbestand.nl/Bestand-QH6EGWUS6NTF.xlsm)

Private Sub Worksheet_Change(ByVal Target As Range)
    
    For Each c In Range("aantal1")
        If Value.intersection(c) > 0 Then
            rij = c.Row
            Cells(rij, "Q") = Range("P1"): Cells(rij, "R") = Range("P2"): Cells(rij, "T") = Range("R1")
        End If
    Next
         
End Sub

 

[danny147]

Beste cissie1

For Each c In Range("aantal1")

Bedoel je hiermee kolom S ?


Probeer deze eens.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    For Each c In Range("S5:S500")
        If c > 0 Then
            rij = c.Row
            Cells(rij, "Q") = Range("P1"): Cells(rij, "R") = Range("P2"): Cells(rij, "T") = Range("R1")
        End If
    Next
         
End Sub

Heb deze niet uitgetest, maar gaat dit geen problemen geven bij de volgende ingave.
Hij gaat telkens elke rij de datums vervangen en de naam !

Groetjes Danny. :thumb:

 

[cissie1]

Beste Danny,

Bedankt voor de snelle reactie!.
Ik bedoelde inderdaad kolom s. Alleen geeft hij zoals je voorspelde wel problemen.
Wat ik wil is dat hij alleen de data en de naam in de rij waar het aantal wordt ingevoerd aanpast. Weet jij (of iemand anders?) hoe je dat kunt oplossen?

Groetjes,
Cissie

 

[danny147]

Beste cissie1

dmv een extra kolom te plaatsen Vb. kolom U met als kopnaam OK

De code wordt dan:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    For Each c In Range("S5:S500")
        If c > 0 and c.Offset(, 2) <> "OK" Then
            rij = c.Row
            Cells(rij, "Q") = Range("P1"): Cells(rij, "R") = Range("P2"): Cells(rij, "T") = Range("R1")
c.Offset(, 2) = "OK"
        End If
    Next
         
End Sub

Na het uitvoeren van de code komt in kolom U "OK" te staan.
Deze rij neemt hij de volgende keer niet meer mee.

Groetjes Danny. :thumb:

 

[Roncancio]

Waarom elke rij controleren als maar 1 rij verandert?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Chr(64 + Target.Column) = "S" Then
    Range("Q" & Target.Row).Value = Range("P1").Value
    Range("R" & Target.Row).Value = Range("P2").Value
    Range("T" & Target.Row).Value = Range("R1").Value
End If
End Sub

Met vriendelijke groet,


Roncancio

 

[cissie1]

Beste Danny,

Bedankt voor de oplossing. Hij werkt nu eigenlijk zoals ik zou willen, alleen is hij erg traag nu hij één kolom verwerkt. De bedoeling is dat ik er uiteindelijk rond de 13 kolommen mee ga verwerken. Vandaar dat ik hoop dat de functie van Roncancio nog iets aangepast kan worden, zodat het werken met de sheet op normale snelheid blijft gaan.

In ieder geval (alvast) heel erg bedankt!
Ik heb er weer veel van geleerd!

Cissie

 

[cissie1]

Beste Roncancio,

Heel erg bedankt voor het meedenken aan dit 'probleem'.
De code die je hebt geschreven werkt bijna zoals ik zou willen. Nu past hij de regel al aan als ik alleen de cel in kolom S selecteer. Ik zou graag willen dat hij de gegevens pas invult wanneer ik een getal in colom S invoer. Kan dit?

Met vriendelijke groet,
Cissie1

 

[Roncancio]

Private Sub Worksheet_Change(ByVal Target As Range)
If Chr(64 + Target.Column) = "S" Then
    Range("Q" & Target.Row).Value = Range("P1").Value
    Range("R" & Target.Row).Value = Range("P2").Value
    Range("T" & Target.Row).Value = Range("R1").Value
End If
End Sub

Met vriendelijke groet,


Roncancio

 

[danny147]

Beste cissie1

Ik zie dat je enkel over kolom S spreekt, maat hoe zit het met de andere kolommen waar aantal staat nl. bij:

kolom S, W, AA, AE, AI, AM, AQ, AV, AY, BC, BG en BO

Als je dat ook wilt dat deze automatisch ingevuld worden, dan moet je met Offset werken.

Groetjes Danny. :thumb:

 

[cissie1]

De bovenstaande code werkt!!

Je hebt gelijk, ik wil inderdaad dat het ook werkt als ik een aantal in de kolom S, W, AA, AE etc. invoer. Nu dacht ik het op de volgende manier op te lossen:

Private Sub Worksheet_Change(ByVal Target As Range)
If Chr(64 + Target.Column) = "S" Then
    Target.Offset(, -2).Value = Range("P1").Value
    Target.Offset(, -1).Value = Range("P2").Value
    Target.Offset(, 1).Value = Range("R1").Value
End If

If Chr(64 + Target.Column) = "W" Then
    Target.Offset(, -2).Value = Range("P1").Value
    Target.Offset(, -1).Value = Range("P2").Value
    Target.Offset(, 1).Value = Range("R1").Value
End If

If Chr(64 + Target.Column) = "AA" Then
    Target.Offset(, -2).Value = Range("P1").Value
    Target.Offset(, -1).Value = Range("P2").Value
    Target.Offset(, 1).Value = Range("R1").Value
End If

If Chr(64 + Target.Column) = "AE" Then
    Target.Offset(, -2).Value = Range("P1").Value
    Target.Offset(, -1).Value = Range("P2").Value
    Target.Offset(, 1).Value = Range("R1").Value
End If

If Chr(64 + Target.Column) = "AI" Then
    Target.Offset(, -2).Value = Range("P1").Value
    Target.Offset(, -1).Value = Range("P2").Value
    Target.Offset(, 1).Value = Range("R1").Value
End If

'etc.

End Sub

Voor kolom S en kolom W gaat dat goed, maar bij de rest werkt het niet meer... Kun je zo zien wat ik fout doe?? Ik heb gewoon de code gekopieerd en een andere kolom aangegeven. Of is het ook mogelijk de verwijzing naar al deze verschillende kolommen in één stukje code zetten? Ik kan niet vinden hoe ik dit kan doen.

Groeten,
Cissie

Beste cissie1

Ik zie dat je enkel over kolom S spreekt, maat hoe zit het met de andere kolommen waar aantal staat nl. bij:

kolom S, W, AA, AE, AI, AM, AQ, AV, AY, BC, BG en BO

Als je dat ook wilt dat deze automatisch ingevuld worden, dan moet je met Offset werken.

Groetjes Danny. :thumb:

 

[danny147]

Beste cissie1

Je kan toch ook met OR werken zoals dit:

Private Sub Worksheet_Change(ByVal Target As Range)
If Chr(64 + Target.Column) = "S" or Chr(64 + Target.Column) = "W" or Chr(64 + Target.Column) = "AA" Then
    Target.Offset(, -2).Value = Range("P1").Value
    Target.Offset(, -1).Value = Range("P2").Value
    Target.Offset(, 1).Value = Range("R1").Value
End If

End Sub

Groetjes Danny. :thumb:

 

[cissie1]

Okee Wist niet dat dat zo werkte...
Had wel iets met or geprobeerd, maar niet op de juiste manier.

Alleen het werkt de code nog steeds wel bij kolom S en W, maar niet bij de overige kolommen (met dubbele letterverwijzing bv. AA, AE etc.)
Heb even een testje gedaan om alleen kolom AA aan de praat te krijgen (dus AA ingevoerd waar de code nu naar S verwijst). Alleen dan werkt hij ook niet.
Heb je enig idee hoe dit komt?

Beste cissie1

Je kan toch ook met OR werken zoals dit:

Private Sub Worksheet_Change(ByVal Target As Range)
If Chr(64 + Target.Column) = "S" or Chr(64 + Target.Column) = "W" or Chr(64 + Target.Column) = "AA" Then
    Target.Offset(, -2).Value = Range("P1").Value
    Target.Offset(, -1).Value = Range("P2").Value
    Target.Offset(, 1).Value = Range("R1").Value
End If

End Sub

Groetjes Danny. :thumb:

 

[danny147]

Beste cissie1

Roncancio weet wel raad :d

Waarschijnlijk met dit stukje code te maken:

Chr(64 + Target.Column)

Groetjes Danny. :thumb:

 

[Roncancio]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 18 And (Target.Column + 1) Mod 4 = 0 Then
    Target.Offset(0,-2).Value = Range("P1").Value
    Target.Offset(0,-1).Value = Range("P2").Value
    Target.Offset(0, 1).Value = Range("R1").Value
End If
End Sub

Er wordt gekeken naar het kolomnummer.
Dus S = 19(e letter van het alfabet)
W = 23e letter van het alfabet
AA = 27
etc.

Zo te zien verspringt het steeds per 4 kolommen.
Dus als het kolomnummer + 1 deelbaar is dus 4 (vanaf kolom 18) dan gaat de macro aan de slag.
Ongeacht hoeveel kolommen er gebruikt worden.

Met vriendelijke groet,


Roncancio

 

[danny147]

Beste Roncancio

Ik wilde nog reageren op je antwoord, maar ik zie dat je de code hebt aangepast in Offset.

cissie1 zal tevreden zijn met deze werkende code.

Groetjes Danny. :thumb:

 

[cissie1]

Fantastisch!! Het werkt helemaal zoals ik wilde!
Beide heel erg bedankt voor de hulp, de uitleg over de code en de megasnelle reacties!!

Met vriendelijke groet,
Cissie

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 18 And (Target.Column + 1) Mod 4 = 0 Then
    Target.Offset(0,-2).Value = Range("P1").Value
    Target.Offset(0,-1).Value = Range("P2").Value
    Target.Offset(0, 1).Value = Range("R1").Value
End If
End Sub

Er wordt gekeken naar het kolomnummer.
Dus S = 19(e letter van het alfabet)
W = 23e letter van het alfabet
AA = 27
etc.

Zo te zien verspringt het steeds per 4 kolommen.
Dus als het kolomnummer + 1 deelbaar is dus 4 (vanaf kolom 18) dan gaat de macro aan de slag.
Ongeacht hoeveel kolommen er gebruikt worden.

Met vriendelijke groet,


Roncancio

 

[Roncancio]

Okee Wist niet dat dat zo werkte...
Had wel iets met or geprobeerd, maar niet op de juiste manier.

Alleen het werkt de code nog steeds wel bij kolom S en W, maar niet bij de overige kolommen (met dubbele letterverwijzing bv. AA, AE etc.)
Heb even een testje gedaan om alleen kolom AA aan de praat te krijgen (dus AA ingevoerd waar de code nu naar S verwijst). Alleen dan werkt hij ook niet.
Heb je enig idee hoe dit komt?

De reden dat dit niet werkte met AA en verder is omdat je met Chr(64 + kolomnummer) niet verder kan gaan dat tot Z. Ik ging ervan uit dat de vraag het slechts voor de S-kolom betrof.
Vandaar dat ik in de nieuwe code gebruik heb gemaakt van het kolomnummer.
Als kolomnummer + 1 / 4 = 0 (en het kolomnummer is groter dan 18), dan gaat de macro aan de slag. Ongeacht hoeveel kolommen je ernaast toevoegt (voor zover het mogelijk is in de Excelversie die je gebruikt).

Met vriendelijke groet,


Roncancio