ffionnah

Board Regular
Joined
Jun 12, 2018
Messages
61
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 :LOL:. 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.

Code:
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

Board Regular
Joined
Jun 12, 2018
Messages
61
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?
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,406
Office Version
  1. 365
Platform
  1. Windows
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

Board Regular
Joined
Jun 12, 2018
Messages
61
I am still using the same code you updated (i updated it just a little bit)

Rich (BB code):
     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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,406
Office Version
  1. 365
Platform
  1. Windows
It needs to be
Code:
[COLOR=#ff0000]ActiveCell.offset(1).Row[/COLOR]
 

ffionnah

Board Regular
Joined
Jun 12, 2018
Messages
61

ADVERTISEMENT

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

Board Regular
Joined
Jun 12, 2018
Messages
61
Ooo i got it!

Rich (BB code):
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,406
Office Version
  1. 365
Platform
  1. Windows
You're welcome
 

Watch MrExcel Video

Forum statistics

Threads
1,129,281
Messages
5,635,290
Members
416,851
Latest member
zeldadav

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top