Creating a loop to fill data?

[imsyun]

Hi all, I've been tasked to clean a dataset and prepare it for SPSS which doesn't handle blank rows well. The dataset looks something like this:

Basically, there are people visiting each with their own ID and each row is a visit. I have to copy the DOB, sex, and calculate age at time of visit for each person. So something like the image below which I've been doing manually. There are also random gaps throughout because of other data.

However, the task is very repetitive, especially with so much data. I'm sure there's a faster way to do it but I'm not sure how. I tried searching online but I haven't had much luck, probably because I don't know how to describe the issue.

I would appreciate any tips or what I should be searching to find possible solutions. Thanks!

 

[mumps]

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[imsyun]

Book1
	A	B	C	D	E	F	G
1	New ID	Visit ID	Person No.	Visit No.	DOB	Sex	Age
2	1	1	72	2/4/08	23/12/1965	Male	42.1163587
3	1	2	72	1/27/09
4	1	3	72	12/8/09
5	1	4	72	11/19/10
6
7
8
9
10
11
12	2	1	74	3/7/08	26/01/1976	Female
13	2	2	74	1/27/09
14	2	3	74	1/21/10
15	2	4	74	1/6/11
16	2	5	74	5/4/12
17	2	6	74	4/22/13
18	3	1	80	1/29/08	16/09/1997	Male
19	3	2	80	5/12/09
20	3	3	80	3/25/10
21
Sheet1

Cell Formulas
Range	Formula
A2:A21	A2	=IF(C2="","",IF(COUNTIF($C$2:C2,C2)>1,MAX($A$1:A1),MAX($A$1:A1)+1))
B2:B21	B2	=IF(COUNTIF($C$2:C2,C2),COUNTIF($C$2:C2,C2),"")
G2	G2	=(D2-$E2)/365.25

So for example, for DOB (col E) and Sex (col F) for Person No. 72, their details only appear in E2 and F2 (visit 1), but I'd like to have these details show for every visit (E2:E5 and F2:F5). So far, I've just been dragging and pasting the data for each patient so it's a bit time-consuming.

Similarly, for Age (col G), I'd like to do the same but this time there is a formula involved to calculate the age of the person at each visit. I'm using the formula to calculate the age (D2-E2)/365.25. I don't know how when calculating G2, if there's a way to automatically change the DOB to the next person's without having to do it manually.

I'm trying to create what is shown below with possible formulas or macros.

Book1
	G	H	I	J	K	L	M
1	New ID	Visit ID	Person No.	Visit No.	DOB	Sex	Age
2	1	1	72	2/4/08	23/12/1965	Male	42.1163587
3	1	2	72	1/27/09	24/12/1965	Male	43.0937714
4	1	3	72	12/8/09	25/12/1965	Male	43.9534565
5	1	4	72	11/19/10	26/12/1965	Male	44.8980151
6
7
8
9
10
11
12	2	1	74	3/7/08	26/01/1976	Female	32.1122519
13	2	2	74	1/27/09	27/01/1976	Female	33.0020534
14	2	3	74	1/21/10	28/01/1976	Female	33.982204
15	2	4	74	1/6/11	29/01/1976	Female	34.9377139
16	2	5	74	5/4/12	30/01/1976	Female	36.2600958
17	2	6	74	4/22/13	31/01/1976	Female	37.2238193
18	3	1	80	1/29/08	16/09/1997	Male	10.3682409
19	3	2	80	5/12/09	17/09/1997	Male	11.6495551
20	3	3	80	3/25/10	18/09/1997	Male	12.5147159
Sheet1

Cell Formulas
Range	Formula
G2:G20	G2	=IF(A2="","",IF(COUNTIF($A$2:A2,A2)>1,MAX($G$1:G1),MAX($G$1:G1)+1))
H2:H20	H2	=IF(COUNTIF($A$2:A2,A2),COUNTIF($A$2:A2,A2),"")
M2:M5,M12:M20	M2	=(J2-$K2)/365.25

Thank you

 

[imsyun]

if there's a way to automatically change the DOB to the next person's without having to do it manually.

sorry, this isn't relevant for age so please ignore

 

[Joe4]

There may be more efficient ways of coding it, but here is one way that should do what you want:

Sub MyPopulateData()

    Dim lr As Long, r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows, starting on row 2
    For r = 2 To lr
'       Check for data in column A and blank in column G
        If (Cells(r, "A") <> "") And (Cells(r, "G") = "") Then
'           Populate formula in column G
            Cells(r, "G").FormulaR1C1 = "=(RC[-3]-RC5)/365.25"
'           Check for values in columns E and F
            If Cells(r, "E") = "" Then
'               Copy values from row above
                Range(Cells(r - 1, "E"), Cells(r - 1, "F")).Copy Cells(r, "E")
            End If
        End If
    Next r
    
    Application.ScreenUpdating = True
    
    MsgBox "Macro complete!"
    
End Sub

 

[imsyun]

Hello. Thanks for your response. It seems to be working for the spreadsheet I shared. I tried to use the script for the actual data and changed a couple of the column names:

Sub MyPopulateData()

    Dim lr As Long, r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows, starting on row 2
    For r = 2 To lr
'       Check for data in column A and blank in column G
        If (Cells(r, "A") <> "") And (Cells(r, "H") = "") Then
'           Populate formula in column G
            Cells(r, "H").FormulaR1C1 = "=(RC[-4]-RC5)/365.25"
'           Check for values in columns F and G
            If Cells(r, "F") = "" Then
'               Copy values from row above
                Range(Cells(r - 1, "F"), Cells(r - 1, "G")).Copy Cells(r, "F")
            End If
        End If
    Next r
    
    Application.ScreenUpdating = True
    
    MsgBox "Macro complete!"
    
End Sub

When I run it, the age formula (col H) doesn't seem to work properly for the 3rd person onwards (row 18). The formula doesn't work for the top row (visit 1) for each person but it is calculated correctly from visit 2 onwards. For sex (col G), it worked for the first participant (rows 1-5), but for the rest, it either left it as before or it disappeared.

current-wd-patient_V2_20220617 copy_saved with macro.xlsm
	A	B	C	D	E	F	G	H
1	Subject ID	Visit ID	Person ID	Vist	DOB	Date 1	Sex	Age
2	1	1	72	5/6/11	23/10/1972	27/07/2011	Male	38.5325
3	1	2	72	3/5/13	23/10/1972	27/07/2011	Male	40.3641
4	1	3	72	12/8/18	23/10/1972	27/07/2011	Male	46.1246
5	1	4	72	11/19/19	23/10/1972	27/07/2011	Male	47.0719
6
7
8
9
10
11
12	2	1	75	3/7/06	11/02/2000			6.06708
13	2	2	75	1/27/09	11/02/2000			8.96099
14	2	3	75	1/21/11	11/02/2000			10.9432
15	2	4	75	1/6/11	11/02/2000			10.9021
16	2	5	75	5/4/19	11/02/2000			19.2252
17	2	6	75	4/22/13	11/02/2000			13.1937
18	3	1	82	1/29/08	17/05/1990	01/03/2015	Male	=(RC[-4]-RC5)/365.25
19	3	2	82	5/12/11	17/05/1990	01/03/2015	Male	20.9856
20	3	3	82	3/25/13	17/05/1990	01/03/2015	Male	22.8556
21
22
23
24
25	4	1	84		14/01/1930	20/11/2008	Male	=(RC[-4]-RC5)/365.25
26	5	1	85	3/10/08	29/09/1940	15/12/2008	Male	=(RC[-4]-RC5)/365.25
27
28
29
30	6	1	87	3/17/08	14/10/1950			=(RC[-4]-RC5)/365.25
31
32	7	1	812		09/05/1943			=(RC[-4]-RC5)/365.25
33	8	1	813	4/28/08	03/06/1930			=(RC[-4]-RC5)/365.25
34	9	1	814		14/09/1989			=(RC[-4]-RC5)/365.25
35	10	1	815	2/5/09	03/01/1925	13/01/2016	Female	=(RC[-4]-RC5)/365.25
36
37
38
39	11	1	816	2/3/09	08/12/1937			=(RC[-4]-RC5)/365.25
40
41
42	12	1	817	4/12/08	03/10/1969	29/06/2017	Male	=(RC[-4]-RC5)/365.25
43	12	2	817	5/19/08	03/10/1969	29/06/2017		38.6256
44	12	3	817	5/21/09	03/10/1969	29/06/2017		39.6304
45	12	4	817	6/20/09	03/10/1969	29/06/2017		39.7125
46	12	5	817	5/16/11	03/10/1969	29/06/2017		41.6153
Data

Cell Formulas
Range	Formula
A2:A46	A2	=IF(C2="","",IF(COUNTIF($C$2:C2,C2)>1,MAX($A$1:A1),MAX($A$1:A1)+1))
B2:B46	B2	=IF(COUNTIF($C$2:C2,C2),COUNTIF($C$2:C2,C2),"")
H2:H5,H43:H46,H19:H20,H12:H17	H2	=(D2-$E2)/365.25

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
1:1048576	Expression	=IFBLANK($A2)	text	YES
1:1867	Expression	=MOD($A1,2)=0	text	NO
1:1867	Expression	=MOD($A1,2)=1	text	NO

Similar to what I need to do for the sex column, I need to do it for other variables. Could you explain this line of code as I don't full understand?

' Check for values in columns E and F If Cells(r, "E") = "" Then ' Copy values from row above Range(Cells(r - 1, "E"), Cells(r - 1, "F")).Copy Cells(r, "E") End If

Thanks again.

 

[Joe4]

Why do you keep changing the layout (columns) of the file?
The last three images you posted are all different structures.
It is very hard to right code for you if things keep changing.

Can you post a new image of your ACTUAL strucutre, with data BEFORE the macro has been run, so I can test it and amend it for that?

 

[imsyun]

Apologies for the continuous changes. The one below is the actual structure of the data set, though I have removed some identifiable data which didn't need any changes so I hope it's okay now

Book3
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Subject ID	Visit ID	PID	Visit Date	DOB	Date	Sex	Age	Time since 1st visit (days)	Number	Char	Y/N	Ignore Col	Ignore Col	Status
2	1	1	72	6/5/11	23/10/1972	27/07/2011	Male		0	17	A	Y			Active
3	1	2	72	5/3/13					698
4	1	3	72	8/12/18					2625
5	1	4	72	11/19/19					3089
6
7
8
9
10
11
12	2	1	75	3/7/06	11/02/2000		Female		0	18	B	Y			Cancelled
13	2	2	75	1/27/09					1057
14	2	3	75	1/21/11					1781
15	2	4	75	1/6/11					1766
16	2	5	75	5/4/19					4806
17	2	6	75	4/22/13					2603
18	3	1	82	1/29/08	17/05/1990	01/03/2015	Male			19	B	N			Cancelled
19	3	2	82	5/12/09
20	3	3	82	3/25/10
Sheet1

Cell Formulas
Range	Formula
A2:A20	A2	=IF(C2="","",IF(COUNTIF($C$2:C2,C2)>1,MAX($A$1:A1),MAX($A$1:A1)+1))
B2:B20	B2	=IF(COUNTIF($C$2:C2,C2),COUNTIF($C$2:C2,C2),"")
I2:I5	I2	=D2-$D$2
I12:I17	I12	=D12-$D$12

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A1:O26	Expression	=IFBLANK($A2)	text	YES
A1:O26	Expression	=MOD($A1,2)=0	text	NO
A1:O26	Expression	=MOD($A1,2)=1	text	NO

What I'm trying to do is:
1. Get the same data to appear for the same person for columns E (DOB), F (Date- not all people have one), G (Sex), J (Number), K (Char), L (Y/N) and O (Status).
2.
a) Create a formula for Age for each participant at the time of visit for column H (Col D which is Visit date - Col E DOB)
b) Create a formula for Time since the first visit (e.g for the first person's second visit - D3 - $D$2). The formula is there at the moment for just the first 2 participants.

I appreciate your help

 

[Joe4]

This seems to work on your latest sample data:

Sub MyPopulateData()

    Dim lr As Long, r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows, starting on row 2
    For r = 2 To lr
'       Check for data in column A
        If (Cells(r, "A") <> "") Then
'           Check to see if column E is blank
            If (Cells(r, "E") = "") Then
'               Copy columns E to O
                Range(Cells(r - 1, "E"), Cells(r - 1, "O")).Copy Cells(r, "E")
            Else
'               Populate formulas in columns H and I
                Cells(r, "H").FormulaR1C1 = "=(RC[-4]-RC[-3])/365.25"
                Cells(r, "I").FormulaR1C1 = "=RC[-5]-MINIFS(C[-5],C[-8],RC[-8])"
            End If
        End If
    Next r
    
'   Format columns H and I as number
    Columns("H:H").NumberFormat = "0.0000"
    Columns("I:I").NumberFormat = "0"

    Application.ScreenUpdating = True
    
    MsgBox "Macro complete!"
    
End Sub

 

[imsyun]

Thanks so much for your help!