Verzuimrapport met VBA

[Michiel82]

Ik wil graag een verzuimrapport maken met behulp van VBA, wie kan mij helpen?

Het document moet het volgende kunnen:

Tabblad data:
Hier worden alle registraties vastgelegd
- kolom A t/m D zijn vaste gegevens
- Kolom E wordt pas gevuld na beter melding
- kolom F wordt kan 2 statussen hebben: Open of Gesloten
- kolom G en H zijn vaste waarden (kunnen gevuld worden middels een dropdown)

Telkens als een nieuwe opmerking wordt toch gevoegd aan de medewerker wordt dit vastgelegd in kolom I en J. Ik kies ervoor om hierdoor telkens kolommen A t/m H opnieuw vast te leggen.

Tabblad Hoofscherm:
Het onderste subscherm wordt gevuld op basis van de gegevens die vastliggen in de tabblad data, hierbij zijn er 2 filtercriteria:
- Manager (middels dropdown)
- Status (middels dropdown)

Als het scherm is gevuld, moet de mogelijkheid er zijn om op een naam te klikken om naar scherm 1 te gaan.

Ook een zoekoptie moet er in dit scherm mogelijk zijn en op basis van deze criteria, moeten de gegevens weergegeven worden

Indien er een nieuwe melding is moet deze aangemaakt kunnen worden middels een knop. We gaan dan naar Scherm 2

Scherm 1
Als je in het hoofdscherm op een naam heb geklikt, opent scherm 1 en het bovenste subscherm wordt gevuld op basis van de gegevens uit tabblad data met als parameter de gegevens uit tabblad hoofdscherm.
Het onderste subscherm wordt gevuld op basis van de gegevens uit tabblad data met als parameter de gegevens uit het bovenste subscherm

Je moet een nieuwe opmerking kunnen toevoegen middels een knop, waarbij 2 velden gevuld moeten worden (datum opmerking en opmerking). Er komt dan een nieuwe regel in tabblad data. Waarbij kolom A t/m H vast staan en kolom I en J op basis van de nieuwe invoer.

Als je op de knop gegevens wijzigen drukt, kan je de gegevens veranderen in het bovenste subscherm. Dit wordt dan ook doorgevoerd in tabblad data.

Scherm 2
Als je in het hoofdscherm op nieuwe naam toevoegen drukt, ga je naar scherm 2
In dit scherm moeten al deze velden ingevuld worden en dit moet vervolgens doorgevoerd/toegevoegd worden in tabblad data.


Ik hoop dat jullie mij kunnen helpen.

Voor vragen....

 

[AD1957]

Ik zie alleen maar een aantal krabbels die het nogal onoverzichtelijk maken.
Hoever ben je zelf al gekomen??

 

[Michiel82]

Ik moet nog beginnen met bouwen, maar ik weet eerlijk gezegd niet hoe en waar ik moet beginnen

Ik kan de krabbels wel verder uitwerken in een soort van scherm design, maar ik wel gaan werken met userforms

 

[AD1957]

Begin eerst eens met het ontwerpen van de Userforms.

 

[Michiel82]

Ik ben begonnen en heb een eerste start gemaakt, hoe kan ik nu de listbox (met unieke waarden) vullen op basis van de volgende criteria:
- Rayonmanager
- objectleider
- status

Ik heb nu een knop "tonen" gemaakt. Is dit noodzakelijk?

In de Listbox moeten de volgende velden opgenomen worden uit de sheet database:
Kolom A: Naam
Kolom C: Contracturen
Kolom D: Datum ziek
Kolom E: Datum hersteld
Kolom F: Status

 

[AD1957]

Private Sub UserForm_Initialize()
ListBox1.List = Sheets("Database").ListObjects(1).DataBodyRange.Value
End Sub

Wel zelf nog even columnwidth en column.count goed instellen

 

[VenA]

't weer een prettig voorbeeld @Sytse1. Haal alles eruit wat de gebruikersinterface aanpast. Op application.quit zit ook niemand te wachten.

 

[VenA]

Maak een tabel nooit groter dan nodig. Additem is een trage en onnodig methode om een combobox te vullen.

Private Sub UserForm_Initialize()
  ComboBox1.List = Sheets("List").Columns(2).SpecialCells(2).Offset(1).SpecialCells(2).Value
  ComboBox2.List = Sheets("List").Columns(3).SpecialCells(2).Offset(1).SpecialCells(2).Value
  ListBox1.List = Sheets("Database").ListObjects(1).DataBodyRange.Value
End Sub

 

[Michiel82]

VBA Max waarde in kolom zoeken en verhogen met 1

Hoe vind ik de max waarde in kolom A en kan ik deze verhogen met 1 en daarna gebruiken?

Private Sub CommandButton1_Click()

lastrow = ThisWorkbook.Worksheets("database").Cells(Rows.Count, 1).End(xlUp).Row


'Ik wil in kolom A de max waarde zoeken en deze verhogen met 1
DossierNr = ThisWorkbook.Worksheets("database").DMax(1, 1) + 1
'Hier wil ik het nieuwe dossiernr toevoegen
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 1).Value = DossierNr


'Vanaf hier werkt het
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 2).Value = TextBox1.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 3).Value = TextBox2.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 4).Value = TextBox3.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 5).Value = TextBox4.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 7).Value = "Open"
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 8).Value = ComboBox1.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 9).Value = ComboBox2.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 10).Value = Date
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 11).Value = TextBox5.Text

MsgBox "Melding toegevoegd"

End Sub

 

[edmoor]

Maak er eens dit van:

DossierNr = WorksheetFunction.Max(Sheets("database").Range("A:A")) + 1

 

[Michiel82]

Ik krijg een foutmelding
Zie document in bijlage (het gaat om de scherm nieuwe melding

 

[edmoor]

Je kan ook zien dat dat niets te maken heeft met wat ik liet zien.
Het ophalen van LastRow gaat fout.
Doe dat zo:

LastRow = Sheets("database").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

 

[Michiel82]

Als ik het zo doe werkt het wel, maar wordt geen dossiernr toegevoegd, omdat ik dan een foutmelding krijg

Private Sub CommandButton1_Click()

lastrow = ThisWorkbook.Worksheets("database").Cells(Rows.Count, 2).End(xlUp).Row


[I]    'Ik wil in kolom A de max waarde zoeken en deze verhogen met 1
'DossierNr = WorksheetFunction.Max(Sheets("database").Range("A:A")) + 1
    'Hier wil ik het nieuwe dossiernr toevoegen
'ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 1).Value = DossierNr[/I]

ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 2).Value = TextBox1.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 3).Value = TextBox2.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 4).Value = TextBox3.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 5).Value = TextBox4.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 7).Value = "Open"
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 8).Value = ComboBox1.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 9).Value = ComboBox2.Text
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 10).Value = Date
ThisWorkbook.Worksheets("database").Cells(lastrow + 1, 11).Value = TextBox5.Text

MsgBox "Melding toegevoegd"

End Sub

 

[edmoor]

En weer vertel je niet wat de foutmelding is alsof die er niet toe doen.
Ga het na in debug mode.

 

[Michiel82]

Code werkt wel :thumb:

My mistake!

Volgende keer zet ik de debug melding erbij.

 

[edmoor]

En code in codetags

 

[snb]

En simpeler code:

Private Sub CommandButton1_Click()
  sheets("database").Cells(Rows.Count, 2).End(xlUp).offset(1).resize(,11)=array([Max(database!A:A)]+1,Textbox1,TextBox2,TextBox3,TextBox4,"","Open",ComboBox1,ComboBox2,Date,TextBox5)
End Sub

 

[AD1957]

Waarom begin je hier een nieuwe Topic.

Mod edit: link verwijderd omdat topics zijn samengevoegd.

 

[huijb]

2 topics samengevoegd. Geachte Michiel82. Maak eens gebruik van de handleidingen die er zijn voor het plaatsen van vragen. Code horen tussen codetags.
Bovendien is het niet gewenst om te pas en te onpas topics te openen over hetzelfde onderwerp.

 

[Michiel82]

Hoe kan ik de Kolom B t/m G ook ophalen en deze tonen in mijn listbox. Kolom A bepaald de unieke waarden.

Als ik MyRange verander naar "G", komen deze waarden onder elkaar in mijn listbox in plaats van naast elkaar

Verder wil ik OptionButton 1 of 2 als extra filter gebruiken voor het ophalen van de gegevens.

De onderstaande code heb ik tot dusver:

Private Sub UserForm_Initialize()

Dim i As Long

Me.ListBox1.AddItem

For a = 1 To 7
    Me.ListBox1.List(0, a - 1) = Sheets("Database").Cells(1, a)
Next a
    
    Me.ListBox1.Selected(0) = True

Dim MyList As Collection
Dim MyRange As Range
Dim ws As Worksheet
Dim MyVal As Variant

Set ws = ThisWorkbook.Sheets("Database")
Set MyRange = ws.Range("A2", "A" & ws.Range("A2").End(xlDown))
Set MyList = New Collection

On Error Resume Next
For Each myCell In MyRange.Cells
MyList.Add myCell.Value, CStr(myCell.Value)
Next myCell

On Error GoTo 0

For Each MyVal In MyList
Me.ListBox1.AddItem MyVal
Next MyVal

End Sub