Macro - return to original cell

[ffionnah]

Hi all,
Happy Holidays and thank you in advance for you help. I have a macro I use to identify a unique count for patient names. The goal of this macro is to apply a number to each unique name/dob combination. I have another macro I use to choose a randomized list of numbers within the range of the first macro. (10 unique names, choose 4 randomized numbers between 1 and 10).

What I have been trying to do is combine these macros into one step. The issue I am encountering is having the 2nd macro (randomized list) place the randomized number selection where I need it to be on the spreadsheet, which would be in column AQ, and starting at the corresponding row from the original active cell.

For example; if the original active cell is B5, I would want the randomized list to produce the number selection in AQ5. This would occur after the first portion of the macro goes through all of the names/dob; It continues to count until it reaches a blank cell. I'm not sure how to make the macro return to the original cell (B5) in order to have the second portion of the macro place the randomized number in the corresponding row (AQ5).

I tried adding Cells(RL, CL).Select but that didnt work . I also tried to adjust this line, but that really didnt work either: ActiveCell.Offset(RL, 41).Resize(Num).Value = Out


Below includes both macros together.

Sub IdentifyUniquePT()    Dim RL As Long, CL As Integer
    RL = ActiveCell.Row
    CL = ActiveCell.Column
    
    Range(ActiveCell, ActiveCell.Offset(1, 0)).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    
    CurrentPatientNumber = 1
    ActiveCell.Offset(0, 40).Value = CurrentPatientNumber
    
    Do Until ActiveCell.Value = Empty
       CurrentFN = ActiveCell.Value
       CurrentLN = ActiveCell.Offset(0, 1).Range("A1").Value
       CurrentDOB = ActiveCell.Offset(0, 2).Range("A1").Value
       CurrentRow = ActiveCell.Row
       
       Do Until Not (ActiveCell.Offset(1, 0).Range("A1").Value = CurrentFN And ActiveCell.Offset(1, 1).Range("A1").Value = CurrentLN And ActiveCell.Offset(1, 2).Range("A1").Value = CurrentDOB)
          ActiveCell.Offset(1, 0).Select
          ActiveCell.Offset(0, 40).Value = CurrentPatientNumber
       Loop
       
       ActiveCell.Offset(1, 0).Range("A1").Select
       If Not (ActiveCell.Value = Empty) Then
          CurrentPatientNumber = CurrentPatientNumber + 1
          ActiveCell.Offset(0, 40).Value = CurrentPatientNumber
       End If
    Loop
    MsgBox "Total number of patients = " & CurrentPatientNumber
    TwentyfivePercentOfPatients = 0.25 * CurrentPatientNumber
    MsgBox "To audit " & TwentyfivePercentOfPatients


Cells(RL, CL).Select


Dim PT As Double, Num As Double, Wk() As Double, Out() As Double, x As Long, Y As Long, Q As Long
    
    PT = InputBox("Enter The Total Unique Names", "Enter a Number")
    Num = InputBox("Enter The 25% ", "Enter a Number")
    If Num > PT Then
        MsgBox "The sample size must be less than the total size."
        Exit Sub
    End If
    ReDim Wk(1 To PT)
    ReDim Out(1 To Num, 1 To 1)
    
    For x = 1 To PT
        Wk(x) = x
    Next x
    For x = 1 To Num
        Y = Int(PT * rnd) + 1
        Out(x, 1) = Wk(Y)
        Wk(Y) = Wk(PT)
        PT = PT - 1
    Next x
    
    
    ActiveCell.Offset(RL, 41).Resize(Num).Value = Out
    
End Sub

 

[ffionnah]

Hi! Thank you again for your help. I apologize for the delay; holidays and what not.

This code is selecting Cell (1,42) instead of (2,42). How can i make this select a cell down, yet still include the each randomized number?

 

[Fluff]

As the code in post#4 doesn't select anything, can you please explain what you mean.
Or are you still using your code?

 

[ffionnah]

I am still using the same code you updated (i updated it just a little bit)

     Range(ActiveCell.Offset(1, 42), ActiveCell.End(xlDown).Offset(1, 42)).FormulaR1C1 = "=IFERROR(IF(MATCH(rc[-2],r" & ActiveCell.Row & "c[-1]:r" & CLng(Num) & "c[-1],0),""yes"",""no""),"""")"

This is almost there it just is making the formula select Row 1 instead of Row 2 in this portion: r" & ActiveCell.Row & "c[-1]:r" & CLng(Num) & "c[-1]

Everything else is great. It is pasting the formula where I need it to be.

 

[Fluff]

It needs to be

[COLOR=#ff0000]ActiveCell.offset(1).Row[/COLOR]

 

[ffionnah]

Oooo! We are so close! It moved down to row 2.

It is now selecting one less cell than it needs to. For instance, there are 6 random numbers and it is only selecting 5. Previously, although it was selecting the incorrect cells, it was still select 6 cells.

 

[ffionnah]

Ooo i got it!

Range(ActiveCell.Offset(1, 42), ActiveCell.End(xlDown).Offset(1, 42)).FormulaR1C1 = "=IFERROR(IF(MATCH(rc[-2],r" & ActiveCell.Offset(1).Row & "c[-1]:r" & CLng(Num + 1) & "c[-1],0),""yes"",""no""),"""")"

In blue is what i updated!

Thank you very, very much!

 

[Fluff]

You're welcome