[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.
Code:
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]