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]

How about:

Sub EnterData()
'
    Dim Cost        As Double, Days     As Double, Refills  As Double
    Dim lr          As Long
    Dim Doctor      As String, Num      As String, Pharm    As String, Rx   As String
'
    lr = Range("A" & Rows.Count).End(xlUp).Row
'
'   Generate Consecutive Record Number
    Range("A" & lr + 1).Value = Range("A" & lr).Value + 1
'
'   Enter Rx Number
    Num = InputBox("Please enter the Prescription Number.", "Prescription Number", Default, XPos:=2880, YPos:=5760)
    Range("B" & lr + 1).Value = Num

'   Enter the Current Date
    Range("C" & lr + 1).Value = Format(Now, "m/d/yyyy")
    Range("C" & lr + 1).Name = "FillDate"
'
'   Enter the Prescription Name
    Rx = InputBox("Please enter the Prescription Name.", "Prescription Name", Default, XPos:=2880, YPos:=5760)
    Range("D" & lr + 1).Value = Rx

'   Enter the Pharmacy Name
    Pharm = InputBox("Please enter the Pharmacy Name.", "Pharmacy Name", Default, XPos:=2880, YPos:=5760)
    Range("E" & lr + 1).Value = Pharm

'   Enter the Doctor's Name
    Doctor = InputBox("Please enter the Doctor's Name.", "Doctor's Name", Default, XPos:=2880, YPos:=5760)
    Range("F" & lr + 1).Value = Doctor
    
'   Enter the Number of Refills
    Refills = InputBox("Please enter the Number of Refills.", "Number of Refills", Default, XPos:=2880, YPos:=5760)
    Range("G" & lr + 1).Name = "Refills"
    Range("G" & lr + 1).Value = Refills

'   Enter the Cost
    Cost = InputBox("Please enter the Cost.", "Cost", Default, XPos:=2880, YPos:=5760)
    Range("H" & lr + 1).Value = Cost
    Range("H" & lr + 1).Name = "Cost"

'   Enter the Days
    Days = InputBox("Please enter the Days.", "Days", Default, XPos:=2880, YPos:=5760)
    Range("I" & lr + 1).Value = Days
'
' Duplicate same row values according to # of refills
    Range("A" & lr + 1).Resize(Refills + 1, 9).Value = Range("A" & lr + 1 & ":I" & lr + 1).Value
'
    Application.Goto Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1)
End Sub

 

[JohnZ1156]

Hi JohnnyL
Thank you for your suggestion. Cool that now it takes the data without moving the cell pointer.

Works pretty well, but I thought my macro showed that column A should be a consecutive "Record" number increasing by 1 for each additional row..
Also, the "refills" column G should subtract by 1, from the Refil variable number to zero, as the number of refills decreases.

 

[johnnyL]

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.

That is what you asked for and what I delivered.

 

[johnnyL]

Perhaps you might use XL2BB to show what the before and after you are looking for.

 

[JohnZ1156]

If you read my "comment" line in my macro for column A is says "Generate Consecutive Record Number".

 

[johnnyL]

And if you tested the code I provided, the very next record entered is incremented by 1 in column A. You then asked for a way to copy the row.

 

[JohnZ1156]

Sorry, you are right. I apologize. I don't want to get into an argument.
I guess I wasn't clear that all of column A titled "Record Number" needed to increment by 1.
I am a newbie to Excel VBA, I do the best I can and I have learned a lot from the assistance I've received on this forum.
I really do appreciate all the help and advice I've received here.

Since your solution technically solved my problem, I will mark your original response as "solved" to acknowledge your help.

 

[johnnyL]

Works pretty well, but I thought my macro showed that column A should be a consecutive "Record" number increasing by 1 for each additional row..
Also, the "refills" column G should subtract by 1, from the Refil variable number to zero, as the number of refills decreases.

Try this out:

Sub EnterDataV2()
'
    Dim Cost        As Double, Days     As Double, Refills  As Double
    Dim lr          As Long, RefillRow  As Long
    Dim Doctor      As String, Num      As String, Pharm    As String, Rx   As String
'
    lr = Range("A" & Rows.Count).End(xlUp).Row
'
'   Generate Consecutive Record Number
    Range("A" & lr + 1).Value = Range("A" & lr).Value + 1
'
'   Enter Rx Number
    Num = InputBox("Please enter the Prescription Number.", "Prescription Number", Default, XPos:=2880, YPos:=5760)
    Range("B" & lr + 1).Value = Num

'   Enter the Current Date
    Range("C" & lr + 1).Value = Format(Now, "m/d/yyyy")
    Range("C" & lr + 1).Name = "FillDate"
'
'   Enter the Prescription Name
    Rx = InputBox("Please enter the Prescription Name.", "Prescription Name", Default, XPos:=2880, YPos:=5760)
    Range("D" & lr + 1).Value = Rx

'   Enter the Pharmacy Name
    Pharm = InputBox("Please enter the Pharmacy Name.", "Pharmacy Name", Default, XPos:=2880, YPos:=5760)
    Range("E" & lr + 1).Value = Pharm

'   Enter the Doctor's Name
    Doctor = InputBox("Please enter the Doctor's Name.", "Doctor's Name", Default, XPos:=2880, YPos:=5760)
    Range("F" & lr + 1).Value = Doctor
    
'   Enter the Number of Refills
    Refills = InputBox("Please enter the Number of Refills.", "Number of Refills", Default, XPos:=2880, YPos:=5760)
    Range("G" & lr + 1).Name = "Refills"
    Range("G" & lr + 1).Value = Refills

'   Enter the Cost
    Cost = InputBox("Please enter the Cost.", "Cost", Default, XPos:=2880, YPos:=5760)
    Range("H" & lr + 1).Value = Cost
    Range("H" & lr + 1).Name = "Cost"

'   Enter the Days
    Days = InputBox("Please enter the Days.", "Days", Default, XPos:=2880, YPos:=5760)
    Range("I" & lr + 1).Value = Days
'
' Duplicate same row values according to # of refills
    If Refills > 0 Then
        Range("A" & lr + 1).Resize(Refills + 1, 9).Value = Range("A" & lr + 1 & ":I" & lr + 1).Value
'
' Correct Column A & Column G values
        For RefillRow = 1 To Refills
            Range("A" & lr + 1 + RefillRow).Value = Range("A" & lr + 1 + RefillRow).Offset(-1).Value + 1
            Range("G" & lr + 1 + RefillRow).Value = Range("G" & lr + 1 + RefillRow).Offset(-1).Value - 1
        Next
    End If
'
    Application.Goto Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1)
End Sub

 

[JohnZ1156]

JohnnyL,
Thank you !
There a couple more things, but I will try to figure them out on my own.