Short and Smart vba code for a report generating.

[mrxdm]

[FONT=Courier New, Courier, monospace, arial, sans-serif]I need your kind help in the following code for preparing a treatment history reports of patients that how can I short and smart it? or any more suggestions form you in this matter.

Private Sub ComboBox1_Enter()   [/COLOR][/FONT][COLOR=#ff0000][FONT=Courier New, Courier, monospace, arial, sans-serif]'**** It takes the names of all patients from Sheet2 where from '****we can select a name to generate his / her medical history report.[/FONT][/COLOR][FONT=Courier New, Courier, monospace, arial, sans-serif][COLOR=#000000]
Dim i As Double
Dim final As Double
Dim tareas As String

ComboBox1.BackColor = &H80000005

For i = 1 To ComboBox1.ListCount

               ComboBox1.RemoveItem 0

           Next i

For i = 11 To 65000
If Sheet2.Cells(i, 2) = "" Then
final = i - 1
Exit For
End If
Next

For i = 11 To final
tareas = Sheet2.Cells(i, 2)
PUF5r.ComboBox1.AddItem (tareas)
Next
End Sub
Private Sub ComboBox1_Click()
Dim i As Long
Dim final As Integer

For i = 11 To 65000
If Sheet2.Cells(i, 2) = "" Then
final = i - 1
Exit For
End If
Next

For i = 11 To final
If ComboBox1 = Sheet2.Cells(i, 2) Then    'according to patient's name it shows more details
PUF5r.Label1.Caption = Sheet2.Cells(i, 1) 'PtR No
PUF5r.Label3.Caption = Sheet2.Cells(i, 3) 's/o d/o w/o
PUF5r.Label2.Caption = Sheet2.Cells(i, 4) 'Relative Name

Exit For
End If
Next

End Sub


Private Sub CommandButton1_Click()  '**** Once the name selected from combobox1 than press CommandButton1 to generate the report.
Dim i As Double 'Long
Dim final As Integer

Me.Hide
Application.ScreenUpdating = False
Worksheets("Rpt").Visible = True
Worksheets("Rpt").Unprotect "xyz" '**** password

On Error Resume Next

For i = 11 To 65000
If Sheet2.Cells(i, 2) = "" Then
final = i - 1
Exit For
End If
Next

For i = 11 To final
If PUF5r.ComboBox1 = Sheet2.Cells(i, 2) Then
Sheet5.Range("$L$9") = "=TODAY()"                    'Name of Sheet5 is Rpt
Sheet5.Range("$L$4") = Sheet2.Cells(i, 1) 'PtR No (Patient's registration no)
Sheet5.Range("$D$13") = Sheet2.Cells(i, 2) 'Patient's Name
Sheet5.Range("$C$14") = Sheet2.Cells(i, 3) 's/o d/o w/o
Sheet5.Range("$D$14") = Sheet2.Cells(i, 4) 'Relative's Name
Sheet5.Range("$D$15") = Sheet2.Cells(i, 5) 'Phone
Sheet5.Range("$L$14") = Sheet2.Cells(i, 6) 'Registration Date
Sheet5.Range("$D$16") = Sheet2.Cells(i, 9) 'Symptoms
Sheet5.Range("$H$15") = Sheet2.Cells(i, 10) 'Tehreak
Sheet5.Range("$M$16") = Sheet2.Cells(i, 14) 'T. visits of this Patient
Sheet5.Range("$K$19") = Sheet2.Cells(i, 10) 'PIN (Tehreak, Pulse indication No)

[/COLOR][/FONT][FONT=Courier New, Courier, monospace, arial, sans-serif][COLOR=#ff0000]'**** I need help here that how I can short this piece of code bellow which generates proper report in worksheet "Rpt"
'**** I want here to copy in sheet "Rpt" (wsheet5) : first treatment given as " treatment date, Treatment given, no of days for medicine is given, food plan " from wsheet2
'**** then if more treatments are given then it should be continued copy in the worksheet "Rpt" after last used row or if there is no more.
'**** treatment given to the patient then do nothing more.[/COLOR][/FONT][FONT=Courier New, Courier, monospace, arial, sans-serif][COLOR=#000000]

Sheet5.Range("$C$19") = Sheet2.Cells(i, 6) 'Trmnt dt1
Sheet5.Range("$D$19") = Sheet2.Cells(i, 11) 'Trmnt1
Sheet5.Range("$L$19") = Sheet2.Cells(i, 12) 'For Days1
Sheet5.Range("$M$19") = Sheet2.Cells(i, 13) 'Food Plan1
Sheet5.Range("$C$21") = Sheet2.Cells(i, 19) 'Trmnt dt2
Sheet5.Range("$K$21") = Sheet2.Cells(i, 20) 'PIN2
Sheet5.Range("$D$21") = Sheet2.Cells(i, 21) 'Trmnt2
Sheet5.Range("$L$21") = Sheet2.Cells(i, 22) 'For Days2
'Sheet5.Range("$M$21") = Sheet2.Cells(i, 13) 'Food Plan2
Sheet5.Range("$C$23") = Sheet2.Cells(i, 23) 'Trmnt dt3
Sheet5.Range("$K$23") = Sheet2.Cells(i, 24) 'PIN3
Sheet5.Range("$D$23") = Sheet2.Cells(i, 25) 'Trmnt3
Sheet5.Range("$L$23") = Sheet2.Cells(i, 26) 'For Days3
Sheet5.Range("$C$25") = Sheet2.Cells(i, 27) 'Trmnt dt4
Sheet5.Range("$K$25") = Sheet2.Cells(i, 28) 'PIN4
Sheet5.Range("$D$25") = Sheet2.Cells(i, 29) 'Trmnt4
Sheet5.Range("$L$25") = Sheet2.Cells(i, 30) 'For Days4
Sheet5.Range("$C$27") = Sheet2.Cells(i, 31) 'Trmnt dt5
Sheet5.Range("$K$27") = Sheet2.Cells(i, 32) 'PIN5
Sheet5.Range("$D$27") = Sheet2.Cells(i, 33) 'Trmnt5
Sheet5.Range("$L$27") = Sheet2.Cells(i, 34) 'For Days5
Sheet5.Range("$C$29") = Sheet2.Cells(i, 35) 'Trmnt dt6
Sheet5.Range("$K$29") = Sheet2.Cells(i, 36) 'PIN6
Sheet5.Range("$D$29") = Sheet2.Cells(i, 37) 'Trmnt6
Sheet5.Range("$L$29") = Sheet2.Cells(i, 38) 'For Days6
Sheet5.Range("$C$31") = Sheet2.Cells(i, 39) 'Trmnt dt7
Sheet5.Range("$K$31") = Sheet2.Cells(i, 40) 'PIN7
Sheet5.Range("$D$31") = Sheet2.Cells(i, 41) 'Trmnt7
Sheet5.Range("$L$31") = Sheet2.Cells(i, 42) 'For Days7
Sheet5.Range("$C$33") = Sheet2.Cells(i, 43) 'Trmnt dt8
Sheet5.Range("$K$33") = Sheet2.Cells(i, 44) 'PIN8
Sheet5.Range("$D$33") = Sheet2.Cells(i, 45) 'Trmnt8
Sheet5.Range("$L$33") = Sheet2.Cells(i, 46) 'For Days8
Sheet5.Range("$C$35") = Sheet2.Cells(i, 47) 'Trmnt dt9
Sheet5.Range("$K$35") = Sheet2.Cells(i, 48) 'PIN9
Sheet5.Range("$D$35") = Sheet2.Cells(i, 49) 'Trmnt9
Sheet5.Range("$L$35") = Sheet2.Cells(i, 50) 'For Days9
Sheet5.Range("$C$37") = Sheet2.Cells(i, 51) 'Trmnt dt10
Sheet5.Range("$K$37") = Sheet2.Cells(i, 52) 'PIN10
Sheet5.Range("$D$37") = Sheet2.Cells(i, 53) 'Trmnt10
Sheet5.Range("$L$37") = Sheet2.Cells(i, 54) 'For Days10
Sheet5.Range("$C$39") = Sheet2.Cells(i, 55) 'Trmnt dt11
Sheet5.Range("$K$39") = Sheet2.Cells(i, 56) 'PIN11
Sheet5.Range("$D$39") = Sheet2.Cells(i, 57) 'Trmnt11
Sheet5.Range("$L$39") = Sheet2.Cells(i, 58) 'For Days11
Sheet5.Range("$C$41") = Sheet2.Cells(i, 59) 'Trmnt dt12
Sheet5.Range("$K$41") = Sheet2.Cells(i, 60) 'PIN12
Sheet5.Range("$D$41") = Sheet2.Cells(i, 61) 'Trmnt12
Sheet5.Range("$L$41") = Sheet2.Cells(i, 62) 'For Days12
Sheet5.Range("$C$43") = Sheet2.Cells(i, 63) 'Trmnt dt13
Sheet5.Range("$K$43") = Sheet2.Cells(i, 64) 'PIN13
Sheet5.Range("$D$43") = Sheet2.Cells(i, 65) 'Trmnt13
Sheet5.Range("$L$43") = Sheet2.Cells(i, 66) 'For Days13
Sheet5.Range("$C$45") = Sheet2.Cells(i, 67) 'Trmnt dt14
Sheet5.Range("$K$45") = Sheet2.Cells(i, 68) 'PIN14
Sheet5.Range("$D$45") = Sheet2.Cells(i, 69) 'Trmnt14
Sheet5.Range("$L$45") = Sheet2.Cells(i, 70) 'For Days14

	'**** above code is for a single page setting of report, what I do if the report exceeds from one page (exceeds then 14 time treatments), how I shift more remaing treatment data to next sheet (add new sheet to enter remaining data with same worksheet format of "Rpt".



Sheet5.Range("$M$49") = Sheet2.Cells(i, 15) 'T Bills amount  '**** it should be copied at bottom of the report.
Sheet5.Range("$M$50") = Sheet2.Cells(i, 16) 'Rcvd
Sheet5.Range("$M$51") = Sheet2.Cells(i, 17) 'Bal
Sheet5.Range("$C$50") = Sheet2.Cells(i, 18) 'Pt Status
Exit For
End If
Next
Worksheets("Rpt").Protect "xyz", DrawingObjects:=True, Contents:=True, Scenarios:=True
Worksheets("Rpt").EnableSelection = xlNoSelection

		
			'**** now convert worksheet Rpt to PDF file name is from cell value $D$13 and opens it in PDF

Worksheets("Rpt").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\ Tib_e_Sabir" & " Report of " & Worksheets("Rpt").Range("$D$13").Value _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
        'MsgBox "PDF file has been created and saved in ""TibSabir"" folder:"
PUF5rI.Show  '**** it shows for more reports to print.

End Sub[/COLOR][/FONT]

 

[mrxdm]

I did it as per your instructions but still facing problem, code is not working properly, the following piece of code is now only executing once and pasting only one data in sheet 5, it is not looping for more data. I saw with the help of breakpoints when code reaches at " Exit For " then it jumps over to " Worksheets("Rpt").EnableSelection = xlNoSelection " not staying at " Next j " or back to j.
there is if statement is also not getting set here if I run this code with the " If .... end if " then it show an error message for "Next without For ... "

 With Worksheets("PtR") 'sheet2
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
        inarr = Range(.Cells(1, 1), .Cells(lastrow, 70))
        End With


    For j = 19 To 45 Step 2
    k = (j - 19) / 2


    'If PUF5r.ComboBox1 = Sheet2.Cells(i, 2) Then
    With Sheet5
            .Range("C" & j).Value = inarr(i, 19 + k)
            .Range("D" & j).Value = inarr(i, 21 + k)
            .Range("K" & j).Value = inarr(i, 20 + k)
            .Range("L" & j).Value = inarr(i, 22 + k)
            '.Range("M" & j).Value = inarr(i, 22 + k)
    End With
    Exit For
    Next j
    'End If

Worksheets("Rpt").EnableSelection = xlNoSelection

 

[offthelip]

Code works perfectly then because that is exactly what exit for will do. Normaly you would only do an "exit for" when a particular condition is met ie. inside a "if" statement, you have got it so it will exit the loop first time..
The if statment and the end if statement are commented out with the single quote , so they will never execute and the end if is in the wrong place anyway
I have no idea what you are trying to do but I suggest deleting the exit for, it will then go round the loop.

 

[mrxdm]

Thanks a lot for your guiding me. And a good news: the code works perfectly now after deleting the " Exit For ".
It is done.

One of the deep secrets of life is that all that is really worth the doing is what we do for others.<cite eza="cwidth:560px;;cheight:28px;;wcalc_source:child;wcalc:46px;wocalc:46px;hcalc:56px;rend_px_area:15680;" cwidth="560" style="max-width: 750px; color: rgb(124, 128, 129); font-size: 14px; font-weight: bold; margin: 25px 0px 0px; display: block; text-align: right; font-family: news-gothic-std, "Helvetica Neue", Helvetica, Arial, sans-serif; background-color: transparent; background-size: auto;"><ins class="ezoic-before-el ezoic-bla-2-marker" eza="cwidth:0px;;cheight:0px;;wcalc_source:child;wcalc:5px;wocalc:5px;hcalc:28px;rend_px_area:0;" cwidth="0" style="max-width: 750px; content: none; background-color: transparent; background-size: auto; line-height: 28px; text-decoration-line: none;">-</ins>Lewis Carroll


</cite>