Excel VB UserForm - Change CommandButton BackColor after click in my Userform - change back to standardColor after click again...

[Pfiffikus]

Hello, I'm not very good at programming ExcelVB code, but I tried to program a smart solution for a friend's problem anyway.

But I don't know what to do now: the user form has a lot of buttons.
They simulate a vaccination record. When you check vaccination records,
you should always press a status button, but each disease can only have one status.
My idea was that when the button is pressed, background-Color should Change to red-color (status Display) and the value in the Excel table cell provided,
should be increased by 1.
If you have click the wrong button, the value should be reduced by 1 and the button should return to its standard color.
That doesn't work - and when all buttons have been pressed, all colored buttons should be set to the standard Color by a Save Button for the next vaccination record check.
Here is my programming first - if you have any further questions, I could explain more here. Sorry for my bad english - be a german - her the Code I have problems:

Option Explicit

'Declaration des Dictionarys
Private buttonStates As Object ' Dictionary für die Button-Zustände

' UserForm Initialisierung
'***************************************
Private Sub UserForm_Initialize()
    ' Dictionary initialisieren
    Set buttonStates = CreateObject("Scripting.Dictionary")
    Dim wsData As Worksheet
    Dim lastRow As Long
    Dim currentTop As Double
    Dim i As Long, j As Integer
    Dim colStart As Integer, colEnd As Integer
    Dim frame As MSForms.frame, button As MSForms.CommandButton

    ' Arbeitsblatt "Data" festlegen
    '--------------------------------
    Set wsData = ThisWorkbook.Sheets("Data")

    ' Scrollbalken einstellen
    '----------------------------
    With Me
        .ScrollBars = fmScrollBarsBoth
        .ScrollHeight = .InsideHeight + 380
        .ScrollWidth = .InsideWidth + 25
    End With

    ' ComboBoxen dynamisch füllen
    '--------------------------------
    FillComboBox Me.cbo_Schuljahr, wsData, "A"
    FillComboBox Me.cbo_Schule, wsData, "B"
    FillComboBox Me.cbo_Klasse, wsData, "C"
    
    ' Label für verbleibende Impfbücher initialisieren
    '-----------------------------------------------------
    Me.lbl_RemainingBooks.Caption = "Rest: " & Me.txtbx_AnzahlImpfbuecher.Value
    Me.lbl_RemainingBooks.Font.Bold = True
    Me.lbl_RemainingBooks.ForeColor = RGB(255, 0, 0) ' Rot
    
End Sub

' Funktion: ComboBox füllen
'***************************************
Private Sub FillComboBox(cbo As MSForms.ComboBox, ws As Worksheet, col As String)
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).row
    cbo.Clear
    cbo.RowSource = ws.name & "!" & col & "2:" & col & lastRow
End Sub

' Button Speichern
'***************************************
Private Sub btn_Speichern_Click()
    Dim wsImpf As Worksheet
    Dim schuljahr As String, schule As String, klasse As String
    Dim anzahlImpfbuecher As String, anzahlSchueler As String
    Dim gesamtImpfbuecher As String, gesamtSchueler As String
    Static remainingBooks As Long ' Zähler für verbleibende Bücher
    
    ' Arbeitsblatt festlegen
    '------------------------------------------------
    Set wsImpf = ThisWorkbook.Sheets("Impfkontrolle")
    
    ' Eingabewerte aus der UserForm auslesen
    '------------------------------------------------
    schuljahr = Me.cbo_Schuljahr.Value
    schule = Me.cbo_Schule.Value
    klasse = Me.cbo_Klasse.Value
    
'    anzahlImpfbuecher = Me.txtbx_AnzahlImpfbuecher.Value
'    anzahlSchueler = Me.txtbx_AnzahlSchueler.Value

    If IsNumeric(Me.txtbx_AnzahlImpfbuecher.Value) Then
        anzahlImpfbuecher = CLng(Me.txtbx_AnzahlImpfbuecher.Value)
    Else
        anzahlImpfbuecher = 0
    End If

    If IsNumeric(Me.txtbx_AnzahlSchueler.Value) Then
        anzahlSchueler = CLng(Me.txtbx_AnzahlSchueler.Value)
    Else
        anzahlSchueler = 0
    End If
    
    If schuljahr = "" Or schule = "" Or klasse = "" Or anzahlImpfbuecher = "" Or anzahlSchueler = "" Then
        MsgBox "Bitte alle Felder ausfüllen!", vbExclamation
        Exit Sub
    End If

    ' Werte in die Tabelle schreiben
    '------------------------------------
    With wsImpf
        .Cells(3, 2).Value = schuljahr
        .Cells(4, 2).Value = schule
        .Cells(5, 2).Value = klasse
        .Cells(6, 2).Value = anzahlImpfbuecher
        .Cells(7, 2).Value = anzahlSchueler
        
        ' Gesamtsummen aktualisieren
        '---------------------------------
        .Cells(6, 5).Value = .Cells(6, 5).Value + anzahlImpfbuecher
        .Cells(7, 5).Value = .Cells(7, 5).Value + anzahlSchueler
    End With
            
        ' Textfelder leeren und Label zurücksetzen
        '-------------------------------------------
        Me.txtbx_AnzahlImpfbuecher.Value = ""
        Me.txtbx_AnzahlSchueler.Value = ""
        Me.lbl_RemainingBooks.Caption = "Rest: 0"
    
    ' Initialisierung des Zählers beim ersten Speichern
    '----------------------------------------------------
    If remainingBooks = 0 Then
        remainingBooks = CLng(anzahlImpfbuecher)
    End If

    ' Zähler reduzieren
    '----------------------
    If remainingBooks > 0 Then
        remainingBooks = remainingBooks - 1
        Me.lbl_RemainingBooks.Caption = "Rest: " & remainingBooks
    End If
    
    ' Erfolgsnachricht
    MsgBox "Daten erfolgreich gespeichert und Gesamtsummen aktualisiert!", vbInformation
    
    ' Wenn alle Bücher kontrolliert sind
    '------------------------------------
    If remainingBooks = 0 Then
        MsgBox "Bitte nächste Klasse auswählen!", vbInformation
    ' Optional: Weitere Logik, z. B. Fortschritt zurücksetzen oder speichern
    End If
End Sub

' Funktion: Zelle inkrementieren
'******************************************
Private Sub IncrementCell(sheetName As String, targetRow As Long, targetColumn As Long, incrementValue As Long)
    Dim ws As Worksheet
    Dim currentValue As Variant

    ' Ziel-Sheet setzen
    Set ws = ThisWorkbook.Sheets(sheetName)

    ' Aktuellen Wert auslesen und inkrementieren
    currentValue = ws.Cells(targetRow, targetColumn).Value

    If IsNumeric(currentValue) Then
        ws.Cells(targetRow, targetColumn).Value = currentValue + incrementValue
    Else
        ws.Cells(targetRow, targetColumn).Value = incrementValue
    End If

End Sub

' Generische Klick-Funktion für Buttons
'*****************************************
Private Sub GenericButtonClick()
    Dim btn As MSForms.CommandButton
    Dim sheetName As String
    Dim targetRow As Long
    Dim targetColumn As Long
    Dim parts() As String
    'Dim buttonKey As String
    Dim ws As Worksheet
    Dim currentValue As Long

    ' Ziel-Sheet festlegen
    sheetName = "Impfkontrolle"
    Set ws = ThisWorkbook.Sheets(sheetName)

    ' Prüfen, ob ActiveControl ein Button ist
    If TypeOf Me.ActiveControl Is MSForms.CommandButton Then
        Set btn = Me.ActiveControl
        'buttonKey = btn.name ' Eindeutiger Schlüssel für den Button
    Else
        MsgBox "Das aktive Steuerelement ist kein Button!", vbExclamation
        Exit Sub
    End If

    ' Button-Name analysieren (z. B. Btn_Tetanus_1)
    parts = Split(btn.name, "_")

    ' Ziel-Reihe und -Spalte bestimmen
    If UBound(parts) = 2 Then
        If InStr(parts(1), "Impftiter") > 0 Then
        ' Impftiter-Logik(Masern-, Mumps-, Röteln-Impftiter)
        Select Case parts(1)
            Case "MasernImpftiter": targetRow = 28
            Case "MumpsImpftiter": targetRow = 29
            Case "RoetelnImpftiter": targetRow = 30
            Case Else
                MsgBox "Unbekannter Impftiter: " & parts(1), vbExclamation
                Exit Sub
        End Select
        
        ' Zielspalte festlegen: Spalte B = 2 oder Spalte E = 5 (abhängig von der letzten Ziffer)
        '----------------------------------------------------------------------------------------
        Select Case CInt(parts(2))
            Case 1
                targetColumn = 2 ' Spalte B
            Case 2
                targetColumn = 5 ' Spalte E
            Case Else
                MsgBox "Ungültige Spalte für Impftiter: " & btn.name, vbExclamation
                Exit Sub
        End Select
    Else
        ' Impfart (z. B. Tetanus) und Zielspalte bestimmen
        Select Case parts(1)
            Case "Tetanus": targetRow = 13
            Case "Diphterie": targetRow = 14
            Case "Pertussis": targetRow = 15
            Case "Polio": targetRow = 16
            Case "HepatitisB": targetRow = 17
            Case "Masern": targetRow = 18
            Case "Mumps": targetRow = 19
            Case "Roeteln": targetRow = 20
            Case "Varizellen": targetRow = 21
            Case "Meningokokken": targetRow = 22
            Case "FSME": targetRow = 23
            Case "HPV": targetRow = 24
            Case Else
                MsgBox "Unbekannte Impfart: " & parts(1), vbExclamation
                Exit Sub
        End Select
    End If

    ' Zielspalte festlegen (B oder E)
    If IsNumeric(parts(2)) Then
        targetColumn = CInt(parts(2)) + 1 ' Spalte B = 2
    Else
        MsgBox "Ungültige Spalte im Button-Namen: " & btn.name, vbExclamation
        Exit Sub
    End If

    ' Aktuellen Wert abrufen
    currentValue = ws.Cells(targetRow, targetColumn).Value
    If Not IsNumeric(currentValue) Then currentValue = 0
        'Logik: Wert erhöhen/reduzieren und Farbe wechseln
        If btn.BackColor = RGB(255, 0, 0) Then
            ' Wenn rot, zurücksetzen
            btn.BackColor = RGB(240, 240, 240) ' Standardfarbe
            ws.Cells(targetRow, targetColumn).Value = currentValue - 1 ' Wert um 1 reduzieren
        Else
            ' Wenn Standardfarbe, erhöhen und rot färben
            btn.BackColor = RGB(255, 0, 0) ' Rot markieren
            ws.Cells(targetRow, targetColumn).Value = currentValue + 1 ' Wert um 1 erhöhen
        End If
    Else
        MsgBox "Ungültiger Button-Name: " & btn.name, vbExclamation
        Exit Sub
    End If
End Sub

' Funktion: Daten exportieren
Private Sub ExportDataToFile()
    Dim ws As Worksheet
    Dim exportFileName As String

    ' Zielarbeitsblatt setzen
    Set ws = ThisWorkbook.Sheets("Impfkontrolle")

    ' Dateiname erstellen
    exportFileName = ThisWorkbook.Path & "\Impfkontrolle_" & Format(Now, "yyyymmdd_HHMMSS") & ".xlsx"
    
    ' Exportieren
    ws.Copy
    ActiveWorkbook.SaveAs Filename:=exportFileName, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close SaveChanges:=False
    MsgBox "Daten exportiert nach: " & exportFileName, vbInformation
End Sub

' Buttons der Form
'***************************************
Private Sub btn_Tetanus_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Tetanus_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Tetanus_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Tetanus_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Tetanus_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Tetanus_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Tetanus_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Tetanus_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Tetanus_5_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Tetanus_5.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_Diphterie_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Diphterie_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Diphterie_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Diphterie_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Diphterie_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Diphterie_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Diphterie_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Diphterie_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Diphterie_5_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Diphterie_5.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_Pertussis_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Pertussis_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Pertussis_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Pertussis_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Pertussis_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Pertussis_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Pertussis_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Pertussis_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Pertussis_5_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Pertussis_5.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_Polio_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Polio_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Polio_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Polio_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Polio_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Polio_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Polio_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Polio_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Polio_5_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Polio_5.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_HepatitisB_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_HepatitisB_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_HepatitisB_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_HepatitisB_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_HepatitisB_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_HepatitisB_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_HepatitisB_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_HepatitisB_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_Masern_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Masern_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Masern_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Masern_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Masern_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Masern_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Masern_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Masern_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_Mumps_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Mumps_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Mumps_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Mumps_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Mumps_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Mumps_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Mumps_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Mumps_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_Roeteln_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Roeteln_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Roeteln_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Roeteln_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Roeteln_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Roeteln_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Roeteln_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Roeteln_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_Varizellen_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Varizellen_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Varizellen_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Varizellen_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Varizellen_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Varizellen_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Varizellen_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Varizellen_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_Meningokokken_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Meningokokken_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Meningokokken_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Meningokokken_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Meningokokken_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Meningokokken_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_Meningokokken_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_Meningokokken_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_FSME_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_FSME_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_FSME_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_FSME_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_FSME_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_FSME_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_FSME_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_FSME_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_FSME_5_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_FSME_5.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_HPV_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_HPV_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_HPV_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_HPV_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_HPV_3_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_HPV_3.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_HPV_4_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_HPV_4.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_MasernImpftiter_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_MasernImpftiter_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_MasernImpftiter_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_MasernImpftiter_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_MumpsImpftiter_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_MumpsImpftiter_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_MumpsImpftiter_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_MumpsImpftiter_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

'---------------------------------------
Private Sub btn_RoetelnImpftiter_1_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_RoetelnImpftiter_1.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

Private Sub btn_RoetelnImpftiter_2_Click()
    Call GenericButtonClick
    ' Aktion des Buttons
    btn_RoetelnImpftiter_2.BackColor = RGB(255, 0, 0) ' Rot markieren
End Sub

 

[Pfiffikus]

I do this in my free time because I normally have another job and I feel sorry for my boyfriend, he's a good guy and there's no digitization in the office. He can do a little VB but only learning by doing, so he can adapt the data sheet in the future
I can't do VB either but I have a good understanding and can simplify things like this and usually implement them (in processes).
I've been reading books for weeks now, mostly in German, searching Microsoft pages and "pieced together" most of it, but also understood it (I thought ). But since I'm leaving the office soon as a digitizer (all concepts and processes are finished) I want to make this easier for my colleagues. After all, there are 1400 vaccination records to check for statistical purposes (there are other solutions, but the office just doesn't understand them ). I've now translated my code into English - as well as the target table - and the data sheet. I hope you now understand a little better what I want to achieve with simple means (Excel is the only tool that is available and everyone can use it without restrictions).

Option Explicit
' Declaration of Dictionarys
' ToDo: Check if need
'-------------------------
Private buttonStates As Object ' Dictionary for the button states
' Your Code Example
Dim CommBtn() As New Class1         'At the start of all code
Private Sub CommandButton1_Click()
End Sub
' UserForm initialization
'***************************************
Private Sub UserForm_Initialize()
    ' Dictionary initialisierenPrivate Sub UserForm_Initialize()
    
Set buttonStates = CreateObject("Scripting.Dictionary")
    Dim wsData As Worksheet
    Dim lastRow As Long
    Dim currentTop As Double
    Dim i As Long, j As Integer
    Dim colStart As Integer, colEnd As Integer
    Dim frame As MSForms.frame, button As MSForms.CommandButton
    
    ' Set the "Data" worksheet
    ' ToDo: Check if can be set this globally
    '--------------------------------
    Set wsData = ThisWorkbook.Sheets("Data")
    
    ' Adjust scroll bar
    '----------------------------
    With Me
        .ScrollBars = fmScrollBarsBoth
        .ScrollHeight = .InsideHeight + 380
        .ScrollWidth = .InsideWidth + 25
    End With
    
    ' Fill ComboBoxes dynamically - from Excelsheet Data
    '----------------------------------------------------
    FillComboBox Me.cbo_Schuljahr, wsData, "A"
    FillComboBox Me.cbo_Schule, wsData, "B"
    FillComboBox Me.cbo_Klasse, wsData, "C"
    
    ' Initialize label for remaining vaccination records
    '-----------------------------------------------------
    Me.lbl_RemainingBooks.Caption = "Rest: " & Me.txtbx_AnzahlImpfbuecher.Value
    Me.lbl_RemainingBooks.Font.Bold = True
    Me.lbl_RemainingBooks.ForeColor = RGB(255, 0, 0) ' Rot
  
    Dim ctrl As MSForms.Control
    Dim tot As Long
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "CommandButton" Then
        'Load only button names that have "_" in the second to last position
        If Mid(ctrl.Name, Len(ctrl.Name) - 1, 1) = "_" Then
            tot = tot + 1
            ReDim Preserve CommBtn(tot)
            Set CommBtn(tot).MultCommand = ctrl
        End If
    End If
    Next
End Sub
' Function: Fill ComboBox
'***************************************
Private Sub FillComboBox(cbo As MSForms.ComboBox, ws As Worksheet, col As String)
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
    cbo.Clear
    cbo.RowSource = ws.Name & "!" & col & "2:" & col & lastRow
End Sub
' Save button - saving Comboboxes in Excelsheets
'************************************************
Private Sub btn_Speichern_Click()
    Dim wsImpf As Worksheet
    Dim schuljahr As String, schule As String, klasse As String
    Dim anzahlImpfbuecher As String, anzahlSchueler As String
    Dim gesamtImpfbuecher As String, gesamtSchueler As String
    Static remainingBooks As Long ' counter for remaining books
    
    ' Set worksheet - table that records the results
    ' ToDo: Check if can be set this globally
    '------------------------------------------------
    Set wsImpf = ThisWorkbook.Sheets("Impfkontrolle")
    
    ' Reading input values from the UserForm
    '------------------------------------------------
    schuljahr = Me.cbo_Schuljahr.Value
    schule = Me.cbo_Schule.Value
    klasse = Me.cbo_Klasse.Value
    
    If IsNumeric(Me.txtbx_AnzahlImpfbuecher.Value) Then
        anzahlImpfbuecher = CLng(Me.txtbx_AnzahlImpfbuecher.Value)
    Else
        anzahlImpfbuecher = 0
    End If
    If IsNumeric(Me.txtbx_AnzahlSchueler.Value) Then
        anzahlSchueler = CLng(Me.txtbx_AnzahlSchueler.Value)
    Else
        anzahlSchueler = 0
    End If
    
    If schuljahr = "" Or schule = "" Or klasse = "" Or anzahlImpfbuecher = "" Or anzahlSchueler = "" Then
        MsgBox "Bitte alle Felder ausfüllen!", vbExclamation
        Exit Sub
    End If
    
    ' Write values into the table
    '------------------------------------
    With wsImpf
        .Cells(3, 2).Value = schuljahr
        .Cells(4, 2).Value = schule
        .Cells(5, 2).Value = klasse
        .Cells(6, 2).Value = anzahlImpfbuecher
        .Cells(7, 2).Value = anzahlSchueler
        
        ' Update totals
        '---------------------------------
        .Cells(6, 5).Value = .Cells(6, 5).Value + anzahlImpfbuecher
        .Cells(7, 5).Value = .Cells(7, 5).Value + anzahlSchueler
    End With
            
        ' Clear text fields and reset labels
        ' ToDo: Maybe After Saving
        '-------------------------------------------
        Me.txtbx_AnzahlImpfbuecher.Value = ""
        Me.txtbx_AnzahlSchueler.Value = ""
        Me.lbl_RemainingBooks.Caption = "Rest: 0"
    
    ' Initialization of the counter when first saving
    '----------------------------------------------------
    If remainingBooks = 0 Then
        remainingBooks = CLng(anzahlImpfbuecher)
    End If
    
    ' Reduce counter of Impfbooks
    '------------------------------
    If remainingBooks > 0 Then
        remainingBooks = remainingBooks - 1
        Me.lbl_RemainingBooks.Caption = "Rest: " & remainingBooks
    End If
    
    ' Success message for saving one vaccination record of many
    MsgBox "Daten erfolgreich gespeichert und Gesamtsummen aktualisiert!", vbInformation
    
    ' If all books are checked - MsgBox
    '------------------------------------
    If remainingBooks = 0 Then
        MsgBox "Bitte nächste Klasse auswählen!", vbInformation
        ' ToDo: Optional: Additional logic, e.g. reset or save progress
    End If
End Sub
' Function: Increment cell
'******************************************
Private Sub IncrementCell(sheetName As String, targetRow As Long, targetColumn As Long, incrementValue As Long)
    Dim ws As Worksheet
    Dim currentValue As Variant
    
    ' Set target sheet
    ' ToDo: Check if can be set this globally
    '------------------------------------------------
    Set ws = ThisWorkbook.Sheets(sheetName)
    
    ' Read and increment current value
    currentValue = ws.Cells(targetRow, targetColumn).Value
    If IsNumeric(currentValue) Then
        ws.Cells(targetRow, targetColumn).Value = currentValue + incrementValue
    Else
        ws.Cells(targetRow, targetColumn).Value = incrementValue
    End If
End Sub
' Generic click function for buttons
'*****************************************
Public Sub GenericButtonClick()
    Dim btn As MSForms.CommandButton
    Dim sheetName As String
    Dim targetRow As Long
    Dim targetColumn As Long
    Dim parts() As String
    Dim ws As Worksheet
    Dim currentValue As Long
    
    ' Set target sheet
    ' ToDo: Check if can be set this globally
    '------------------------------------------------
    sheetName = "Impfkontrolle"
    Set ws = ThisWorkbook.Sheets(sheetName)
    
    ' Check if ActiveControl is a Button
    If TypeOf Me.ActiveControl Is MSForms.CommandButton Then
        Set btn = Me.ActiveControl
    Else
        MsgBox "Das aktive Steuerelement ist kein Button!", vbExclamation
        Exit Sub
    End If
    
    ' Analyze button name (e.g. Btn_Tetanus_1)
    '------------------------------------------
    parts = Split(btn.Name, "_")
    
    ' Determine target row and column
    '----------------------------------
    If UBound(parts) = 2 Then
        If InStr(parts(1), "Impftiter") > 0 Then
        ' vaccination titer logic (measles, mumps, rubella vaccination titer)
        Select Case parts(1)
            Case "MasernImpftiter": targetRow = 28
            Case "MumpsImpftiter": targetRow = 29
            Case "RoetelnImpftiter": targetRow = 30
            Case Else
                MsgBox "Unbekannter Impftiter: " & parts(1), vbExclamation
                Exit Sub
        End Select
        
        ' Set target column: Column B = 2 or Column E = 5 (depending on the last digit)
        '----------------------------------------------------------------------------------------
        Select Case CInt(parts(2))
            Case 1
                targetColumn = 2 ' Column B
            Case 2
                targetColumn = 5 ' Column E
            Case Else
                MsgBox "Ungültige Spalte für Impftiter: " & btn.Name, vbExclamation
                Exit Sub
        End Select
    Else
        ' Determine vaccination type (e.g. tetanus) and target column
        '--------------------------------------------------------------
        Select Case parts(1)
            Case "Tetanus": targetRow = 13
            Case "Diphterie": targetRow = 14
            Case "Pertussis": targetRow = 15
            Case "Polio": targetRow = 16
            Case "HepatitisB": targetRow = 17
            Case "Masern": targetRow = 18
            Case "Mumps": targetRow = 19
            Case "Roeteln": targetRow = 20
            Case "Varizellen": targetRow = 21
            Case "Meningokokken": targetRow = 22
            Case "FSME": targetRow = 23
            Case "HPV": targetRow = 24
            Case Else
                MsgBox "Unbekannte Impfart: " & parts(1), vbExclamation
                Exit Sub
        End Select
    End If
    
    ' Set target column (column B or E)
    '------------------------------------
    If IsNumeric(parts(2)) Then
        targetColumn = CInt(parts(2)) + 1 ' column B = 2
    Else
        MsgBox "Ungültige Spalte im Button-Namen: " & btn.Name, vbExclamation
        Exit Sub
    End If
    
    ' Get current value
    '---------------------
    currentValue = ws.Cells(targetRow, targetColumn).Value
    If Not IsNumeric(currentValue) Then currentValue = 0
        'Logic: Increase/decrease value and change color
        If btn.BackColor = RGB(255, 0, 0) Then
            ' If red, reset
            btn.BackColor = RGB(240, 240, 240) ' standard color
            ws.Cells(targetRow, targetColumn).Value = 0 'currentValue - 1 ' reduce value by 1
        Else
            ' If standard color, increase and color red
            btn.BackColor = RGB(255, 0, 0) ' Color red
            ws.Cells(targetRow, targetColumn).Value = 1 'currentValue + 1 ' Increase value by 1
        End If
    Else
        MsgBox "Ungültiger Button-Name: " & btn.Name, vbExclamation
        Exit Sub
    End If
End Sub
' Function: Export data
'**************************
Private Sub ExportDataToFile()
    Dim ws As Worksheet
    Dim exportFileName As String
    
    'Set target worksheet
    '----------------------
    Set ws = ThisWorkbook.Sheets("Impfkontrolle")
    
    ' Create file name
    '----------------------
    exportFileName = ThisWorkbook.Path & "\Impfkontrolle_" & Format(Now, "yyyymmdd_HHMMSS") & ".xlsx"
    
    ' Export to file
    '----------------
    ws.Copy
    ActiveWorkbook.SaveAs Filename:=exportFileName, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close SaveChanges:=False
    MsgBox "Daten exportiert nach: " & exportFileName, vbInformation
End Sub

 

[Pfiffikus]

Option Explicit
' Declaration of Dictionarys
' ToDo: Check if need
'-------------------------
Private buttonStates As Object ' Dictionary for the button states
' Your Code Example
Dim CommBtn() As New Class1         'At the start of all code
Private Sub CommandButton1_Click()
End Sub
' UserForm initialization
'***************************************
Private Sub UserForm_Initialize()
    ' Dictionary initialisierenPrivate Sub UserForm_Initialize()
   
Set buttonStates = CreateObject("Scripting.Dictionary")
    Dim wsData As Worksheet
    Dim lastRow As Long
    Dim currentTop As Double
    Dim i As Long, j As Integer
    Dim colStart As Integer, colEnd As Integer
    Dim frame As MSForms.frame, button As MSForms.CommandButton
   
    ' Set the "Data" worksheet
    ' ToDo: Check if can be set this globally
    '--------------------------------
    Set wsData = ThisWorkbook.Sheets("Data")
   
    ' Adjust scroll bar
    '----------------------------
    With Me
        .ScrollBars = fmScrollBarsBoth
        .ScrollHeight = .InsideHeight + 380
        .ScrollWidth = .InsideWidth + 25
    End With
   
    ' Fill ComboBoxes dynamically - from Excelsheet Data
    '----------------------------------------------------
    FillComboBox Me.cbo_Schuljahr, wsData, "A"
    FillComboBox Me.cbo_Schule, wsData, "B"
    FillComboBox Me.cbo_Klasse, wsData, "C"
   
    ' Initialize label for remaining vaccination records
    '-----------------------------------------------------
    Me.lbl_RemainingBooks.Caption = "Rest: " & Me.txtbx_AnzahlImpfbuecher.Value
    Me.lbl_RemainingBooks.Font.Bold = True
    Me.lbl_RemainingBooks.ForeColor = RGB(255, 0, 0) ' Rot
 
    Dim ctrl As MSForms.Control
    Dim tot As Long
    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "CommandButton" Then
        'Load only button names that have "_" in the second to last position
        If Mid(ctrl.Name, Len(ctrl.Name) - 1, 1) = "_" Then
            tot = tot + 1
            ReDim Preserve CommBtn(tot)
            Set CommBtn(tot).MultCommand = ctrl
        End If
    End If
    Next
End Sub
' Function: Fill ComboBox
'***************************************
Private Sub FillComboBox(cbo As MSForms.ComboBox, ws As Worksheet, col As String)
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
    cbo.Clear
    cbo.RowSource = ws.Name & "!" & col & "2:" & col & lastRow
End Sub
' Save button - saving Comboboxes in Excelsheets
'************************************************
Private Sub btn_Speichern_Click()
    Dim wsImpf As Worksheet
    Dim schuljahr As String, schule As String, klasse As String
    Dim anzahlImpfbuecher As String, anzahlSchueler As String
    Dim gesamtImpfbuecher As String, gesamtSchueler As String
    Static remainingBooks As Long ' counter for remaining books
   
    ' Set worksheet - table that records the results
    ' ToDo: Check if can be set this globally
    '------------------------------------------------
    Set wsImpf = ThisWorkbook.Sheets("Impfkontrolle")
   
    ' Reading input values from the UserForm
    '------------------------------------------------
    schuljahr = Me.cbo_Schuljahr.Value
    schule = Me.cbo_Schule.Value
    klasse = Me.cbo_Klasse.Value
   
    If IsNumeric(Me.txtbx_AnzahlImpfbuecher.Value) Then
        anzahlImpfbuecher = CLng(Me.txtbx_AnzahlImpfbuecher.Value)
    Else
        anzahlImpfbuecher = 0
    End If
    If IsNumeric(Me.txtbx_AnzahlSchueler.Value) Then
        anzahlSchueler = CLng(Me.txtbx_AnzahlSchueler.Value)
    Else
        anzahlSchueler = 0
    End If
   
    If schuljahr = "" Or schule = "" Or klasse = "" Or anzahlImpfbuecher = "" Or anzahlSchueler = "" Then
        MsgBox "Bitte alle Felder ausfüllen!", vbExclamation
        Exit Sub
    End If
   
    ' Write values into the table
    '------------------------------------
    With wsImpf
        .Cells(3, 2).Value = schuljahr
        .Cells(4, 2).Value = schule
        .Cells(5, 2).Value = klasse
        .Cells(6, 2).Value = anzahlImpfbuecher
        .Cells(7, 2).Value = anzahlSchueler
       
        ' Update totals
        '---------------------------------
        .Cells(6, 5).Value = .Cells(6, 5).Value + anzahlImpfbuecher
        .Cells(7, 5).Value = .Cells(7, 5).Value + anzahlSchueler
    End With
           
        ' Clear text fields and reset labels
        ' ToDo: Maybe After Saving
        '-------------------------------------------
        Me.txtbx_AnzahlImpfbuecher.Value = ""
        Me.txtbx_AnzahlSchueler.Value = ""
        Me.lbl_RemainingBooks.Caption = "Rest: 0"
   
    ' Initialization of the counter when first saving
    '----------------------------------------------------
    If remainingBooks = 0 Then
        remainingBooks = CLng(anzahlImpfbuecher)
    End If
   
    ' Reduce counter of Impfbooks
    '------------------------------
    If remainingBooks > 0 Then
        remainingBooks = remainingBooks - 1
        Me.lbl_RemainingBooks.Caption = "Rest: " & remainingBooks
    End If
   
    ' Success message for saving one vaccination record of many
    MsgBox "Daten erfolgreich gespeichert und Gesamtsummen aktualisiert!", vbInformation
   
    ' If all books are checked - MsgBox
    '------------------------------------
    If remainingBooks = 0 Then
        MsgBox "Bitte nächste Klasse auswählen!", vbInformation
        ' ToDo: Optional: Additional logic, e.g. reset or save progress
    End If
End Sub
' Function: Increment cell
'******************************************
Private Sub IncrementCell(sheetName As String, targetRow As Long, targetColumn As Long, incrementValue As Long)
    Dim ws As Worksheet
    Dim currentValue As Variant
   
    ' Set target sheet
    ' ToDo: Check if can be set this globally
    '------------------------------------------------
    Set ws = ThisWorkbook.Sheets(sheetName)
   
    ' Read and increment current value
    currentValue = ws.Cells(targetRow, targetColumn).Value
    If IsNumeric(currentValue) Then
        ws.Cells(targetRow, targetColumn).Value = currentValue + incrementValue
    Else
        ws.Cells(targetRow, targetColumn).Value = incrementValue
    End If
End Sub
' Generic click function for buttons
'*****************************************
Public Sub GenericButtonClick()
    Dim btn As MSForms.CommandButton
    Dim sheetName As String
    Dim targetRow As Long
    Dim targetColumn As Long
    Dim parts() As String
    Dim ws As Worksheet
    Dim currentValue As Long
   
    ' Set target sheet
    ' ToDo: Check if can be set this globally
    '------------------------------------------------
    sheetName = "Impfkontrolle"
    Set ws = ThisWorkbook.Sheets(sheetName)
   
    ' Check if ActiveControl is a Button
    If TypeOf Me.ActiveControl Is MSForms.CommandButton Then
        Set btn = Me.ActiveControl
    Else
        MsgBox "Das aktive Steuerelement ist kein Button!", vbExclamation
        Exit Sub
    End If
   
    ' Analyze button name (e.g. Btn_Tetanus_1)
    '------------------------------------------
    parts = Split(btn.Name, "_")
   
    ' Determine target row and column
    '----------------------------------
    If UBound(parts) = 2 Then
        If InStr(parts(1), "Impftiter") > 0 Then
        ' vaccination titer logic (measles, mumps, rubella vaccination titer)
        Select Case parts(1)
            Case "MasernImpftiter": targetRow = 28
            Case "MumpsImpftiter": targetRow = 29
            Case "RoetelnImpftiter": targetRow = 30
            Case Else
                MsgBox "Unbekannter Impftiter: " & parts(1), vbExclamation
                Exit Sub
        End Select
       
        ' Set target column: Column B = 2 or Column E = 5 (depending on the last digit)
        '----------------------------------------------------------------------------------------
        Select Case CInt(parts(2))
            Case 1
                targetColumn = 2 ' Column B
            Case 2
                targetColumn = 5 ' Column E
            Case Else
                MsgBox "Ungültige Spalte für Impftiter: " & btn.Name, vbExclamation
                Exit Sub
        End Select
    Else
        ' Determine vaccination type (e.g. tetanus) and target column
        '--------------------------------------------------------------
        Select Case parts(1)
            Case "Tetanus": targetRow = 13
            Case "Diphterie": targetRow = 14
            Case "Pertussis": targetRow = 15
            Case "Polio": targetRow = 16
            Case "HepatitisB": targetRow = 17
            Case "Masern": targetRow = 18
            Case "Mumps": targetRow = 19
            Case "Roeteln": targetRow = 20
            Case "Varizellen": targetRow = 21
            Case "Meningokokken": targetRow = 22
            Case "FSME": targetRow = 23
            Case "HPV": targetRow = 24
            Case Else
                MsgBox "Unbekannte Impfart: " & parts(1), vbExclamation
                Exit Sub
        End Select
    End If
   
    ' Set target column (column B or E)
    '------------------------------------
    If IsNumeric(parts(2)) Then
        targetColumn = CInt(parts(2)) + 1 ' column B = 2
    Else
        MsgBox "Ungültige Spalte im Button-Namen: " & btn.Name, vbExclamation
        Exit Sub
    End If
   
    ' Get current value
    '---------------------
    currentValue = ws.Cells(targetRow, targetColumn).Value
    If Not IsNumeric(currentValue) Then currentValue = 0
        'Logic: Increase/decrease value and change color
        If btn.BackColor = RGB(255, 0, 0) Then
            ' If red, reset
            btn.BackColor = RGB(240, 240, 240) ' standard color
            ws.Cells(targetRow, targetColumn).Value = 0 'currentValue - 1 ' reduce value by 1
        Else
            ' If standard color, increase and color red
            btn.BackColor = RGB(255, 0, 0) ' Color red
            ws.Cells(targetRow, targetColumn).Value = 1 'currentValue + 1 ' Increase value by 1
        End If
    Else
        MsgBox "Ungültiger Button-Name: " & btn.Name, vbExclamation
        Exit Sub
    End If
End Sub
' Function: Export data
'**************************
Private Sub ExportDataToFile()
    Dim ws As Worksheet
    Dim exportFileName As String
   
    'Set target worksheet
    '----------------------
    Set ws = ThisWorkbook.Sheets("Impfkontrolle")
   
    ' Create file name
    '----------------------
    exportFileName = ThisWorkbook.Path & "\Impfkontrolle_" & Format(Now, "yyyymmdd_HHMMSS") & ".xlsx"
   
    ' Export to file
    '----------------
    ws.Copy
    ActiveWorkbook.SaveAs Filename:=exportFileName, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close SaveChanges:=False
    MsgBox "Daten exportiert nach: " & exportFileName, vbInformation
End Sub

 

[DanteAmor]

I've tried the Code but after take new classand writing the first Codeline I get the follow Failure: Error when compiling only allowed in object module - In that way I search in Microsoft Sites for solving (will learn it really) I got the Message by WithEvents - in the new Modul Class1 - do I need more references?

You need to insert the code in a class module:

I share my file with you so you can see how the code is in the module and the code in the class module (Class1)

varios 31ene2025 class commandbutton.xlsm

drive.google.com

 

[Pfiffikus]

You need to insert the code in a class module:

View attachment 121892​

I share my file with you so you can see how the code is in the module and the code in the class module (Class1)

varios 31ene2025 class commandbutton.xlsm

drive.google.com

Thank for helping - i will try out and give my comments