trjhtr

I am pasting here my working code which generate report in worksheet then save it in pdf format then open it in pdf after selecting a name from a combobox in userform then press commandbutton1 to execute it.

Source worksheet2 (RpT) Target worksheet5 (Ptr)

all do well but it is a long code which takes time to perform so any idea to reduce it in a smart way. Any expert brother can re-code it for me?

Private Sub CommandButton1_Click()
Dim i As Double 'Long
Dim final As Integer

Me.Hide
Application.ScreenUpdating = False
Worksheets("Rpt").Visible = True

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("L9") = "=TODAY()"
Sheet5.Range("L4") = Sheet2.Cells(i, 1) 'PtR No
Sheet5.Range("D13") = Sheet2.Cells(i, 2) 'Pt Name
Sheet5.Range("C14") = Sheet2.Cells(i, 3) 's/o d/o w/o
Sheet5.Range("D14") = Sheet2.Cells(i, 4) 'Relative Name
Sheet5.Range("D15") = Sheet2.Cells(i, 5) 'Phone
Sheet5.Range("L14") = Sheet2.Cells(i, 6) 'Reg Date
Sheet5.Range("D16") = Sheet2.Cells(i, 9) 'Symptoms
Sheet5.Range("H15") = Sheet2.Cells(i, 10) 'Tehreak
Sheet5.Range("M16") = Sheet2.Cells(i, 14) 'T. visits
Sheet5.Range("$K$19") = Sheet2.Cells(i, 10) 'PIN (Tehreak, Pulse indication No)
'specialy following this piece of code shoud be reduce.
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

Sheet5.Range("$L$49") = Sheet2.Cells(i, 15) 'T Bills amount
Sheet5.Range("$L$50") = Sheet2.Cells(i, 16) 'Rcvd
Sheet5.Range("$L$51") = Sheet2.Cells(i, 17) 'Bal
Sheet5.Range("$C$50") = Sheet2.Cells(i, 18) 'Pt Status
Exit For
End If
Next

Worksheets("Rpt").EnableSelection = xlNoSelection

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

'Unload Me

End Sub

You are looping without the need to do so. If I've understood your example you can replace your loo For i = 11 to final ... Next with what follows below. Since you're looking at each row in column 2 to see if it matches what's in the combobox you can do that directly without looping.

Dim comboBoxMatch As Range
Set comboBoxMatch = Sheet2.Columns.Find(PUF5r.ComboBox1, LookAt:=xlWhole)

You've already a comment about reducing your code. If you ignore the first group that's populating on row 19 they all follow a pattern for the row and column population. I came up with the two functions below that return the same information. Using the generic name userNumber you supply it as an argument to the function in return you'll get the row and first column that are used for population.

Private Function GetRowFor(ByVal userNumber As Long) As Long
 If userNumber >= 2 Then
 GetRowFor = 19 + (userNumber - 1) * 2
 End If
End Function

Private Function GetFirstSourceColumnFor(ByVal userNumber As Long) As Long
 If userNumber >= 2 Then
 GetFirstSourceColumnFor = 15 + (userNumber - 1) * 4
 End If
End Function

You can now replace the population of users 2-14 with a single sub that takes in the userNumber and will populate the information.

Private Sub PopulateUserInformation(ByVal userNumber As Long, ByVal sourceSheet As Worksheet, ByVal sourceRow As Long, ByVal destinationSheet As Worksheet)
 If userNumber >= 2 Then
 Dim populationRow As Long
 populationRow = GetRowFor(userNumber)

 Dim firstSourceColumn As Long
 firstSourceColumn = GetFirstSourceColumnFor(userNumber)

 destinationSheet.Cells(populationRow, "C").Value2 = sourceSheet.Cells(sourceRow, firstSourceColumn).Value2
 destinationSheet.Cells(populationRow, "K").Value2 = sourceSheet.Cells(sourceRow, firstSourceColumn + 1).Value2
 destinationSheet.Cells(populationRow, "D").Value2 = sourceSheet.Cells(sourceRow, firstSourceColumn + 2).Value2
 destinationSheet.Cells(populationRow, "L").Value2 = sourceSheet.Cells(sourceRow, firstSourceColumn + 3).Value2
 End If
End Sub

From here it's about replacing lines of code with the updated sub procedure calls. The population of information now resides in its own sub, and its name describes what it's doing.

Private Sub PopulateInformation(ByVal sourceSheet As Worksheet, ByVal sourceRow As Long, ByVal destinationSheet As Worksheet)
 destinationSheet.Range("L9").Value2 = "=TODAY()"
 destinationSheet.Range("L4").Value2 = sourceSheet.Cells(i, 1).Value2 'PtR No
 destinationSheet.Range("D13").Value2 = sourceSheet.Cells(i, 2).Value2 'Pt Name
 destinationSheet.Range("C14").Value2 = sourceSheet.Cells(i, 3).Value2 's/o d/o w/o
 destinationSheet.Range("D14").Value2 = sourceSheet.Cells(i, 4).Value2 'Relative Name
 destinationSheet.Range("D15").Value2 = sourceSheet.Cells(i, 5).Value2 'Phone
 destinationSheet.Range("L14").Value2 = sourceSheet.Cells(i, 6).Value2 'Reg Date
 destinationSheet.Range("D16").Value2 = sourceSheet.Cells(i, 9).Value2 'Symptoms
 destinationSheet.Range("H15").Value2 = sourceSheet.Cells(i, 10).Value2 'Tehreak
 destinationSheet.Range("M16").Value2 = sourceSheet.Cells(i, 14).Value2 'T. visits
 destinationSheet.Range("$K$19").Value2 = sourceSheet.Cells(i, 10).Value2 'PIN (Tehreak, Pulse indication No)

 'The first one doesn't follow a pattern. As such it's handled separately
 'Consider having it also follow the same pattern
 destinationSheet.Range("$C$19").Value2 = sourceSheet.Cells(i, 6).Value2 'Trmnt dt1
 destinationSheet.Range("$D$19").Value2 = sourceSheet.Cells(i, 11).Value2 'Trmnt1
 destinationSheet.Range("$L$19").Value2 = sourceSheet.Cells(i, 12).Value2 'For Days1
 destinationSheet.Range("$M$19").Value2 = sourceSheet.Cells(i, 13).Value2 'Food Plan1

 'destinationsheet.Range("$M$21").value2 = sourcesheet.Cells(i, 13).value2 'Food Plan2
 PopulateUserInformation 2, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 3, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 4, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 5, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 6, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 7, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 8, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 9, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 10, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 11, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 12, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 13, sourceSheet, sourceRow, destinationSheet
 PopulateUserInformation 14, sourceSheet, sourceRow, destinationSheet

 destinationSheet.Range("$L$49").Value2 = sourceSheet.Cells(i, 15).Value2 'T Bills amount
 destinationSheet.Range("$L$50").Value2 = sourceSheet.Cells(i, 16).Value2 'Rcvd
 destinationSheet.Range("$L$51").Value2 = sourceSheet.Cells(i, 17).Value2 'Bal
 destinationSheet.Range("$C$50").Value2 = sourceSheet.Cells(i, 18).Value2 'Pt Status
End Sub

Your main macro now shows a higher level view without showing all the details. You can certainly move things around and add error handling. Please note that On Error Resume Next will plow through any errors that arise, and I've removed its use.

Private Sub CommandButton1_Click()
 Me.Hide
 Application.ScreenUpdating = False
 Worksheets("Rpt").Visible = True

 Dim comboBoxMatch As Range
 Set comboBoxMatch = Sheet2.Columns.Find(PUF5r.ComboBox1, LookAt:=xlWhole)
 If Not comboBoxMatch Is Nothing Then
 PopulateInformation Sheet2, comboBoxMatch.Row, sheet5
 End If

 Worksheets("Rpt").EnableSelection = xlNoSelection

 Dim fileSaveName As String
 fileSaveName = ThisWorkbook.Path & " Tib_e_Sabir" & " Report of " & Worksheets("Rpt").Range("$D$13").Value2
 Worksheets("Rpt").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileSaveName, _
 Quality:=xlQualityStandard, _
 IncludeDocProperties:=True, _
 IgnorePrintAreas:=False, _
 OpenAfterPublish:=True

 'MsgBox "PDF file has been created and saved in ""TibSabir"" folder:"
 PUF5rI.Show

 'Unload Me
End Sub