Excel rij tellen in formulier (vba)

[Koers]

Beste Excel kenners,

Voor mijn stage ontwikkel ik een eigen formulier in Excel 2007 m.b.v. VBA. De gebruiker kan een offertenummer opzoeken, waarna de rest van het formulier vervolgens automatisch wordt ingevuld.

Echter wanneer een gebruiker een offertenummer opzoekt, en hier een aanpassing in doet. (bijv. de offertestatus) maakt excel een nieuwe regel aan en kopieert alles in een nieuwe rij.

Wat ik dus wil is dat Excel de offerte aanpast, ipv een nieuwe rij maakt en alles kopieert.
(zit het met rowcount te proberen, maar het lukt maar niet.)

Iemand een idee hoe een eventuele code eruit kan zien?

Greets,
Koers.

 

[Gert Bouwmeeste]

Voorbeeldbestand zonder gevoelige informatie is wel handig

 

[Roncancio]

Met Find kan je het offertenummer opzoeken en de bijbehorende Row gebruiken om gegevens weg te schrijven.

Met vriendelijke groet,


Roncancio

 

[Koers]

Met Find kan je het offertenummer opzoeken en de bijbehorende Row gebruiken om gegevens weg te schrijven.

Met vriendelijke groet,


Roncancio

Beste Roncanio en Bouwmeester,

Dank voor de snelle reactie.
Ik kan helaas geen voorbeeld posten omdat het gehele bestand uit gevoelige informatie bestaat. Hoe zal een combinatie van find en row eruit komen te zien? Op het internet staan volop tips om de laatste row te vinden, (voor een hele nieuwe offerte.) Maar helaas niet om een huidige offerte aan te passen.

 

[Hoornvan]

Koers,

Deze code heeft volgens mij Roncancio dit eens geschreven voor het aan passen van de informatie.

Private Sub Aanpassen_button_Click()
    Dim lrij As Long
    With Worksheets(1).Range("C1:C65536")
    Set WA = .Find(Cbo_WA_nr.Value, LookIn:=xlValues, LookAt:=xlWhole)
    WA.Select
    Cells(WA.Row, "E").Value = Zoeken_van_werkaanvragen.Cbo_Cap_Gr.Value
    End With
End Sub

Misschien heb je er wat aan.

 

[Roncancio]

Een simpel voorbeeld.
In bijgevoegd bestand zit een menu.
Op dit menu zitten 2 dropdownlijsten (nummer en tekst)
Kies je een nummer dan verschijnt bij tekst de bijbehorende tekst.
Verander je de tekst en klik je op OK dan wordt de tekst van de bron aangepast.

Bijv.

Nr Tekst
100 dag
200 doei
300 ok

Je kiest voor 200 (doei) en verandert de tekst in het tekstvak in "tot ziens".
Het overzicht wordt dan:

Nr Tekst
100 dag
200 tot ziens
300 ok

Met vriendelijke groet,


Roncancio

 

[Roncancio]

Koers,

Deze code heeft volgens mij Roncancio dit eens geschreven voor het aan passen van de informatie.

Private Sub Aanpassen_button_Click()
    Dim lrij As Long
    With Worksheets(1).Range("C1:C65536")
    Set WA = .Find(Cbo_WA_nr.Value, LookIn:=xlValues, LookAt:=xlWhole)
    WA.Select
    Cells(WA.Row, "E").Value = Zoeken_van_werkaanvragen.Cbo_Cap_Gr.Value
    End With
End Sub

Misschien heb je er wat aan.

Zonder WA.Select mag ik hopen.:shocked:

Met vriendelijke groet,


Roncancio

 

[Hoornvan]

Roncancio,

Zonder WA.Select mag ik hopen.

Ik denk wel dat hij snap dat het naar zijn behoefte moet worden aangepast.
Het gaat tenslotte om de code.

 

[Roncancio]

Roncancio,
Ik denk wel dat hij snap dat het naar zijn behoefte moet worden aangepast.
Het gaat tenslotte om de code.

Dat begrijp ik en daar ben ik het ook volledig mee eens. :thumb:
Maar waar het mij om gaat is dat ik (en meerderen) prediken om geen .Select oid te gebruiken.
Dat zou het wel opmerkelijk zijn als .Select tussen mijn code staat.

Met vriendelijke groet,


Roncancio

 

[Hoornvan]

Roncancio,

Maar waar het mij om gaat is dat ik (en meerderen) prediken om geen .Select oid te gebruiken.
Dat zou het wel opmerkelijk zijn als .Select tussen mijn code staat.

Sorry dan heb ik mij vergist en zal het wel iemand anders geschreven hebben.

 

[Koers]

Helemaal super al deze reacties!
Ik ga gelijk met het voorbeeld aan de slag, jullie horen van me.

Gr,
Koers.

 

[snb]

Suggestie

in plaats van

Private Sub Aanpassen_button_Click()
    Dim lrij As Long
    With Worksheets(1).Range("C1:C65536")
    Set WA = .Find(Cbo_WA_nr.Value, LookIn:=xlValues, LookAt:=xlWhole)
    WA.Select
    Cells(WA.Row, "E").Value = Zoeken_van_werkaanvragen.Cbo_Cap_Gr.Value
    End With
End Sub

kan het ook met deze one-liner

Private Sub Aanpassen_button_Click()
  on error resume next
  Worksheets(1).columns(3).Find(Cbo_WA_nr.Value).offset(,2).Value = Zoeken_van_werkaanvragen.Cbo_Cap_Gr.Value
End Sub

 

[Roncancio]

kan het ook met deze one-liner

Private Sub Aanpassen_button_Click()
  on error resume next
  Worksheets(1).columns(3).Find(Cbo_WA_nr.Value,xlValues, xlWhole).offset(,2).Value = Zoeken_van_werkaanvragen.Cbo_Cap_Gr.Value
End Sub

Je bent wel van de on-liners.
Persoonlijk vind ik ook dat zo weinig mogelijk regels gebruikt moeten worden maar het moet wel leesbaar zijn. Een regel van een paar honderd karakters lijkt mij is dat niet.
Bovendien is het moeilijker om fouten te vinden, want ik neem aan dat je de code getest hebt en dat je gemerkt hebt dat het niet de juiste resultaat gaf. '

On Error Resume Next
 Worksheets(1).Columns(3).Find(cbo_wa_nr.Value, , xlValues, xlWhole).Offset(, 2).Value = zoeken_van_werkaanvragen.Cbo_Cap_Gr.Value

Zo lukt het wel.

Met vriendelijke groet,


Roncancio

 

[snb]

Ik ben meer van one-liners dan van

on-liners

.
Dank voor de kritische blik; vorige code daarmee nog iets compacter gemaakt.

 

[Roncancio]

Jij ook bedankt voor de kritische blik:thumb:

Met vriendelijke groet,


Roncancio

 

[Koers]

Hartelijk dank voor alle hulp.
Niet alleen loopt deze code perfect, het is ook een stuk korter dan wat ik in gedachte had!

Heb de code op deze manier toegepast:

Dim lnr
Private Sub txtoffertenr_change()

With Sheets("Offertes").Range("tabofferte[offertenummer]")
    Set lnr = .Find(txtoffertenr.Value, LookIn:=xlValues, lookat:=xlWhole)
     If Not lnr Is Nothing Then
        txtproduct.Value = lnr.Offset(0, 2)
        txtbedrag.Value = lnr.Offset(0, 7)
        txtverkoper.Value = lnr.Offset(0, 6)
        txtklant.Value = lnr.Offset(0, 1)
        txtdatum.Value = lnr.Offset(0, 3)
        txtstatus.Value = lnr.Offset(0, 14)
        txtorder.Value = lnr.Offset(0, 5)
        txtopmerkingen.Value = lnr.Offset(0, 15)
    End If
End With


End Sub
Private Sub cmdtoevoegen_Click()
lnr.Offset(0, 7) = txtbedrag.Value
lnr.Offset(0, 6) = txtverkoper.Value
lnr.Offset(0, 1) = txtklant.Value
lnr.Offset(0, 3) = txtdatum.Value
lnr.Offset(0, 14) = txtstatus.Value
lnr.Offset(0, 5) = txtorder.Value
lnr.Offset(0, 15) = txtopmerkingen.Value

End Sub

Wanneer een gebruiker echter een nieuwe offerte wil toevoegen werkt bovenstaande code (uiteraard) niet. Ik probeer dit op te lossen met onderstaande code.

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Offertes")

'Vind eerste lege rij in database
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(1, 0).Row

'Kopieer de ingevoerde data in de database
ws.Cells(iRow, 1).Value = Me.txtoffertenr.Value
ws.Cells(iRow, 2).Value = Me.txtklant.Value
ws.Cells(iRow, 3).Value = Me.txtproduct.Value
ws.Cells(iRow, 8).Value = Me.txtbedrag.Value
ws.Cells(iRow, 16).Value = Me.txtopmerkingen.Value
ws.Cells(iRow, 4).Value = Me.txtdatum.Value
ws.Cells(iRow, 7).Value = Me.txtverkoper.Value
ws.Cells(iRow, 15).Value = Me.txtstatus.Value
ws.Cells(iRow, 6).Value = Me.txtorder.Value

De code zoekt de eerstvolgende lege regel, en kopieert de data in de tabel.
Echter werkt dit niet, ik vermoed dat ik het te ingewikkeld maak op bovenstaande manier.
Suggesties voor een betere uitwerking?

 

[Hoornvan]

Koers,

Heb je hier wat aan?

Dim lrij As Long
        lrij = ActiveSheet.Range("C65536").End(xlUp).Row
        Cells(lrij + 1, "C").Value = Ingeven_van_werkaanvragen.Txt_wa.Text
        Cells(lrij + 1, "D").Value = Ingeven_van_werkaanvragen.Txt_omschrijving
        Cells(lrij + 1, "E").Value = Ingeven_van_werkaanvragen.Cbo_Cap_Gr.Value
        Cells(lrij + 1, "F").Value = Ingeven_van_werkaanvragen.Cbo_Week.Value
        Cells(lrij + 1, "G").Value = Ingeven_van_werkaanvragen.Txt_Datum
        Leeg_button_Click

 

[snb]

Als je de tekstvakken wat handiger namen geeft

Private Sub txtoffertenr_change()
  With Sheets("Offertes").Range("tabofferte[offertenummer]").Find(txtoffertenr.Value, ,xlValues,xlWhole )
    for j= 1 to 8
      Me("txt" & j).Value = .Offset(, j)
    next
  End With
End Sub

Private Sub cmdtoevoegen_Click()
  With Sheets("Offertes").Range("tabofferte[offertenummer]").Find(txtoffertenr.Value, ,xlValues,xlWhole )
    for j= 1 to 8
      .Offset(, j) = Me("txt" & j).Value
    next
  End With
End Sub

'Kopieer de ingevoerde data in de database

Worksheets("Offertes").Cells(Rows.Count, 1).End(xlUp).Offset(1 ).resize(,9)=split(Me.offertenummer & "|" & txtklant & "|" txtproduct & "|" & txtbedrag & "|" &txtopmerkingen & "|" & txtdatum & "|" & txtverkoper & "|" & txtstatus &"|" & txtorder,"|")

Werp hier eens een blik

 

[Koers]

Beste snb,

Een erg interessante code die met heel weinig regels hetzelfde resultaat bereikt.
De code maakt bij een nieuw nr idd een rij onder de database aan, maar dit doet die echter voor elke letter, ipv te wachten tot het formulier is ingevuld.
(Heb jou voorbeeldformulier gedeeltelijk gebruikt in de code.)

Private Sub txtoffertenr_change()
  With Sheets("Offertes").Range("tabofferte[offertenummer]").Find(txtoffertenr.Value, , xlValues, xlWhole)
   If txtoffertenr.ListIndex > -1 Then
   
    For j = 1 To 9
      Me("txt" & j).Value = .Offset(, j)
    Next
Else
 
Worksheets("Offertes").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 9) = Split(Me.txtoffertenr & "|" & txtklant & "|" & txtproduct & "|" & txtbedrag & "|" & txtopmerkingen & "|" & txtdatum & "|" & txtverkoper & "|" & txtstatus & "|" & txtorder, "|")
    
    End If
  End With
End Sub
Private Sub cmdtoevoegen_Click()
  With Sheets("Offertes").Range("tabofferte[offertenummer]").Find(txtoffertenr.Value, , xlValues, xlWhole)
    For j = 1 To 9
      .Offset(, j) = Me("txt" & j).Value
     Next
  End With
End Sub

Wat klopt er niet aan deze code?