I need to create a multiTab Userform which should be used to input laboratory test results (as backup plan in case of IT-issues) and generate a printable report per patient. The tabs in the form represent different areas in the lab (hematology, coagulation, clinical chemistry, etc). The report should then also have these sub-headings, if data was input into the form. For example if data were provided in the hematology and clinical chemistry tab but not in the other tabs, then the report should only habe "hematology" as sub heading and the the values provided below that.

I made the userform and the script to generate a printable template for each patient. I am able to add the values provided as shown in the images (sorry everything in German, but you get the idea):

The problem is that there will be about 150 input fields and I dont want to validate every single input seperately. I tried using a subroutine which iterates over all controls and adds only valid values into an array which then is passed to the sub adding these values onto the report. But I just can´t figure out how to format and arrange all the data in the way mentioned above.

Is there a "compact" way to solve this?

CodePudding user response：

Consider configuring the layout as an array and then use a loop to check values/fill sheet. For example

Sub report()

    Dim ws, ar(1), r As Long, i As Long
    ar(0) = Array("ery,Erythrozyten,T/L", "hb,Hämoglobin,g/dL", _
                  "hkt,Hämatokrit,%", "mcv,MCV,fL", "mch,MCH,pg", _
                  "mchc,MCHC,%", "wbc,Leukozyten,G/L", "plt,Thrombozyten,G/L")
    
    ar(1) = Array("neut,Neutrophile G.,%", "lymp,Lymphozyten,%", _
                  "mono,Monozyten,%", "eo,Eosinophile G.,%", _
                  "baso,Basophile G.,%")
              
    Set ws = Sheet1
    r = 1
    For i = 0 To 1
        Call fillData(ws, r, ar(i))
        r = r   1
    Next
                
End Sub

Sub fillData(ws, ByRef r As Long, ar)
   Dim t, a, v
   
   ' check first value
   a = Split(ar(0), ",")
   v = UserForm1.Controls("txt_" & a(0)).Value
   If Len(Trim(v)) = 0 Then Exit Sub
   
   For Each t In ar
       a = Split(t, ",")
       v = UserForm1.Controls("txt_" & a(0)).Value
       If Len(v) > 0 Then
          ws.Cells(r, "E") = a(1)
          ws.Cells(r, "G") = v
          ws.Cells(r, "H") = a(2)
          r = r   1
       End If
    Next

End Sub

CodePudding user response：

I don't fully understand of your expected result. Anyway, the code below assumed that the Userform already done as in your image where each page of the MultiPage contains label control and textbox control.

Since the writing to sheet is also using the Label caption besides the Textbox value, so in my side, the Label name has a number suffix which is the same with number suffix of the Textbox name. This is to be used as identifier.

The identifier number continue on each page of the multipage. For example :
Page1 has 3 Labels and 3 Textboxes, each with name "Label-01" to "Label-03" and "tb-01" to "tb-03".
Page2 has 3 Labels and 3 Textboxes, each with name "Label-04" to "Label-06" and "tb-04" to "tb-06".
Page3 has 3 Labels and 3 Textboxes, each with name "Label-07" to "Label-09" and "tb-07" to "tb-09".
And so on.

The sub is to write the information in the Userform to the active sheet.
The sub doesn't write the information on the first page of the userform multipage.
Each sub-heading with data will be written at row 9, starting at column A,
where the next sub-heading will be at column A offset(0,4).
Each time the button is clicked, it will clear first range("A9:Z100000").

Private Sub CommandButton1_Click()
dim cek as boolean:dim rgSubH as range:dim i as integer
dim subH as string:dim ctrl:dimLBL

cek = False
Range("A9:Z100000").Clear
Set rgSubH = Range("A9")
For i = 1 To Me.MultiPage1.Pages.Count - 1
    For Each ctrl In Me.MultiPage1.Pages(i).Controls
    If TypeName(ctrl) = "TextBox" Then _
        If ctrl.Value <> "" Then cek = True: Exit For Else cek = False
    Next
If cek = True Then
    subH = MultiPage1.Pages(i).Caption
    If rgSubH.Value <> "" Then Set rgSubH = Cells(9, Columns.Count).End(xlToLeft).Offset(0, 4)
    rgSubH.Value = subH
        For Each ctrl In MultiPage1.Pages(i).Controls
            If TypeName(ctrl) = "TextBox" Then
                If ctrl.Value <> "" Then
                LBL = Replace(ctrl.Name, "tb", "Label-")
                rgSubH.Offset(1, 0).Value = Controls(LBL).Caption
                rgSubH.Offset(1, 1).Value = ctrl.Value
                Set rgSubH = rgSubH.Offset(1, 0)
                End If
            End If
        Next ctrl
End If
Next i
End Sub

Basically there are three loops.

1. The most outer loop is to loop each page of the multipage userform.
   
2. second loop is a complete inner loop to check if the looped page textbox controls are all empty or not. If all empty it flag as False, if not all empty, it flags as true.
   
3. if the flag is true then the third loop is to write the information on the looped page to the sheet.
   
4. Before the third loop, it get the looped page name as subH variable then it check if cell A9 (rgSubH variable) has value or not. If cell A9 already has a value, it set the rgSubH to offset(0,4).

In the third loop, it loop to each control in the looped page.
If the looped control has value, it gets the caption of the label as LBL variable, then it write the LBL value and the looped control value (the Textbox in this case) to the sheet.

Please note, the code doesn't consider :

1. the "Kommentar" Textbox. So, it won't write the "Kommentar" TextBox to the sheet. Besides, I don't know in what cell you want to appear the "Kommentar" value on the sheet.
   
2. the "g/dl", "U/L", "%" etc. I believe it can be added by using Vlookup where the data is prepared before hand.
3. skip one row if the textbox is on the right, as seen on the "HEMATOLOGIE" page and on the sheet.

Also please note that the sub-heading (and it's data) will be very very wide to the right if the textbox in all page of the multipage userform has value.