Copy row in table using a variable number of times.

[JohnZ1156]

I have a table to keep track of prescription refills.
After I enter the Rx info in a row, I would like the macro to duplicate the row data the number of rows using the "Refills" variable.
Example, if the Rx has 4 refills, I would like it to copy the row 4 more times.

Here is the macro I created to initially enter the data.

Sub EnterData()

    Dim Num As String
    Dim Rx As String
    Dim Pharm As String
    Dim Doctor As String
    Dim Refills As Double
    Dim Cost As Double
    Dim Days As Double
    Dim lr As Long
        
    Range("A1048576").End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    
'   Generate Consecutive Record Number
    ActiveCell.Offset(-1, 0).Activate
    ActiveCell.Offset(1) = ActiveCell + 1
    ActiveCell.Offset(1, 1).Activate
    
'   Enter Rx Number
    Selection.ClearContents
    Num = InputBox("Please enter the Prescription Number.", "Prescription Number", Default, XPos:=2880, YPos:=5760)
    ActiveCell.Value = ActiveCell.Value & Num
    
'   Enter the Current Date
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Format(Now, "mm/dd/yyyy")
    ActiveCell.NumberFormat = "m/d/yyyy"
    ActiveCell.Name = "FillDate"
    
'   Enter the Prescription Name
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    Rx = InputBox("Please enter the Prescription Name.", "Prescription Name", Default, XPos:=2880, YPos:=5760)
    ActiveCell.Value = ActiveCell.Value & Rx

'   Enter the Pharmacy Name
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    Pharm = InputBox("Please enter the Pharmacy Name.", "Pharmacy Name", Default, XPos:=2880, YPos:=5760)
    ActiveCell.Value = ActiveCell.Value & Pharm

'   Enter the Doctor's Name
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    Doctor = InputBox("Please enter the Doctor's Name.", "Doctor's Name", Default, XPos:=2880, YPos:=5760)
    ActiveCell.Value = ActiveCell.Value & Doctor
    
'   Enter the Number of Refills
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    Refills = InputBox("Please enter the Number of Refills.", "Number of Refills", Default, XPos:=2880, YPos:=5760)
    ActiveCell.Value = ActiveCell.Value & Refills
    ActiveCell.Name = "Refills"

'   Enter the Cost
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    Cost = InputBox("Please enter the Cost.", "Cost", Default, XPos:=2880, YPos:=5760)
    ActiveCell.Value = ActiveCell.Value & Cost
    ActiveCell.Name = "Cost"

'   Enter the Days
    ActiveCell.Offset(0, 1).Select
    Selection.ClearContents
    Days = InputBox("Please enter the Days.", "Days", Default, XPos:=2880, YPos:=5760)
    ActiveCell.Value = ActiveCell.Value & Days
    ActiveCell.Offset(1, -8).Select

End Sub

 

[johnnyL]

Glad to help.