Copy excel entries into new work sheet and rearrange the values

KokoroAyo · Sep 10, 2017

I need help on an assignment. Its a list of patients meant for healthcare purposes. This list is sent to us in PDF format and we just search to find any entitled patient on the list. Now we have to convert to excel and rearrange for better management. My task now is to handle the rearrangement using macro since rearranging all manualy takes weeks and we receive the list on monthly basis.

I have never done this before and I am lost as to how to handle it. Please help.

Below is the format of the list. It is arranged in Header - List format but we need it in a different format as shown in the Sample Output format.

Sample List (with Little Explanation
1. Rows like 26645 are headers (there are footers also) and will be automatically removed
2. Hospital No (First part of Row 26646) is Unique to each Hospital). I will form a new field
3. Hospital Name Will form a new field or will be ignored
4. Row 26647 carries Family ID and Family Name. Asterisks will be removed to get the Number
5. Row 26648 Shows details of Family Head (Proncipal). Unique Id will be FamilyId + 0. That is 027926670. It forms a Unique Field
6. Principal/Spouse/Child is the Membership in the Family - hence it forms a field
7. Family Name forms a Field
8. Field B is First Name
9. Field C contains Date of Birth and Gender. This will be broken down to separate fields. Last Part of the string can be ignored (it is Batch Number)

Embedded Broken Image removed

Sample from the Original Excel Sheet


Ronsberger Nigeria Ltd.		Issued by NHIS
	OY/0250 Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State
02792267 SANUSI
0 Principal SANUSI	TEMILADE	02/11/1980 M E/240
1 Spouse SANUSI	OLUWADAMILOLA 19/03/1992 F E/240
02792269 OKOLO
0 Principal OKOLO	EMMANUEL 23/10/1980 M E/240
2 Child1 OKOLO	CHUKWUEMEKA 13/06/2015 M E/240
3 Child2 OKOLO	UZOAMAKA 03/05/2013 F E/240
02792277 AWOLOLA
0 Principal AWOLOLA	AJIBOLA	10/08/1977 M E/240
1 Spouse AWOLOLA	ABIDEMI	05/08/1982 F E/240
2 Child1 AWOLOLA	MORAYOOLUWA 20/06/2012 F E/240
02792285 AGBABIAJE
0 Principal AGBABIAJE	TOLULOPE	26/07/1985 M E/240
02792353 ODUGBEMI
0 Principal ODUGBEMI	RAFIU	13/02/1981 M E/240
1 Spouse ODUGBEMI	TOYIN	04/08/1990 F E/240
2 Child1 ODUGBEMI	OLAMIDE	25/07/2012 F E/240
3 Child2 ODUGBEMI	EMMANUEL 10/10/2006 M E/240
02839471 ADEJIMI
0 Principal ADEJIMI	ADEKUNLE 28/06/1978 M E/344
1 Spouse ADEJIMI	OLUBUNMI 14/07/1979 F E/344
2 Child1 ADEJIMI	OLUWADABIRA 08/07/2007 M E/344

Sample Expected Output

SN (Serial Number - Autogenerated)	CLIENT_NUMBER (HEADNUMBER without the '*' + UNIT NUMBER AS IN DOCUMENT) - PLEASE TAKE NOTE OF LEADING ZEROS	SURNAME (FAMILY NAME AS IN DOCCUMENT)	FIRST_NAME (AS IN DOCUMENT)	DATE_OF_BIRTH (AS IN DOCUMENT)	GENDA (AS IN DOCUMENT)	FAMILY_MEMBERSHIP (AS INDICATED IN DOCUMENT) - Options are: Principal, Spouse and Child	HOSPITAL_NAME (COPY HEADER HOSPITAL NAME FOR ALL CLIENTS FOUND UNDER IT)	HOSPITAL_ID (COPY CORRESPONDING HEADER HOSPITAL ID FOR ALL CLIENTS FOUND UNDER IT)
See Examples Below
1	027922670	SANUSI	TEMILADE	02/11/1980	M	Principal	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State	OY/0250
2	027922671	SANUSI	OLUWADAMILOLA	19/03/1992	F	Spouse	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State	OY/0250
3	027922690	OKOLO	EMMANUEL	23/10/1980	M	Principal	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State	OY/0250
4	027922691	OKOLO	CHUKWUEMEKA	13/06/2015	M	Child	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State	OY/0250
5	027922692	OKOLO	UZOAMAKA	03/05/2013	F	Child	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State	OY/0250
6	027922770	AWOLOLA	AJIBOLA	10/08/1977	M	Principal	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State	OY/0250
7	027922771	AWOLOLA	ABIDEMI	05/08/1982	F	Spouse	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State	OY/0250
8	027922772	AWOLOLA	MORAYOOLUWA	20/06/2012	F	Child	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State	OY/0250

My major problem is the rearrangement of this data.
If required, I can upload a sample workbook if there is an avenue for uploading file, or I can put it in a place and share the link.

Thanks in advance.

KokoroAyo · Sep 10, 2017

Sample Expected Output (reformatted). Thank you Peter_SSs for your kind guidance.
Excel 2007

	A	B	C	D	E	F	G	H	I
1	SN	CLIENTNO	FAMILYNAME	FIRST_NAME	BIRTHDATE	SEX	FAMILY_MEMBERSHIP	HOSPITALID	HOSPITAL_NAME
2	1	027922670	SANUSI	TEMILADE	02/11/1980	M	Principal	OY/0250	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State
3	2	027922671	SANUSI	OLUWADAMILOLA	19/03/1992	F	Spouse	OY/0250	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State
4	3	027922690	OKOLO	EMMANUEL	23/10/1980	M	Principal	OY/0250	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State
5	4	027922691	OKOLO	CHUKWUEMEKA	13/06/2015	M	Child	OY/0250	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State
6	5	027922692	OKOLO	UZOAMAKA	03/05/2013	F	Child	OY/0250	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State
7	6	027922770	AWOLOLA	AJIBOLA	10/08/1977	M	Principal	OY/0250	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State
8	7	027922771	AWOLOLA	ABIDEMI	05/08/1982	F	Spouse	OY/0250	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State
9	8	027922772	AWOLOLA	MORAYOOLUWA	20/06/2012	F	Child	OY/0250	Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State

OUTPUT SAMPLE

And this is the Original data (as converted from the PDF document)
Excel 2007

	A	B	C
26644
26645	Ronsberger Nigeria Ltd.		Issued by NHIS
26646		OY/0250 Catholic Hospital, Oluyoro - Oluyoro, Ibadan, Oyo State
26647	02792267 SANUSI
26648	0 Principal SANUSI	TEMILADE	02/11/1980 M E/240
26649	1 Spouse SANUSI	OLUWADAMILOLA	19/03/1992 F E/240
26650	02792269 OKOLO
26651	0 Principal OKOLO	EMMANUEL	23/10/1980 M E/240
26652	2 Child1 OKOLO	CHUKWUEMEKA	13/06/2015 M E/240
26653	3 Child2 OKOLO	UZOAMAKA	03/05/2013 F E/240
26654	02792277 AWOLOLA
26655	0 Principal AWOLOLA	AJIBOLA	10/08/1977 M E/240
26656	1 Spouse AWOLOLA	ABIDEMI	05/08/1982 F E/240
26657	2 Child1 AWOLOLA	MORAYOOLUWA	20/06/2012 F E/240

Original

MickG · Sep 10, 2017

Based on your original data, Try this for results on sheet2 starting "A1".
NB:- I have assumed that the Data (starting point) :- " *02792267* SANUSI" is in cell "A3".

Code:

[COLOR="Navy"]Sub[/COLOR] MG10Sep17
[COLOR="Navy"]Dim[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, Hd1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Hd2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, R [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, nSp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("A3", Range("A" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count + 1, 1 To 9)
 ray(1, 1) = "Ser Num": ray(1, 2) = "CLIENT_NUMBER": ray(1, 3) = "Surname": ray(1, 4) = "First Name": ray(1, 5) = "DATE_OF_BIRTH": ray(1, 6) = "GENDA": ray(1, 7) = "FAMILY_MEMBERSHIP": ray(1, 8) = "HOSPITAL_NAME": ray(1, 9) = "HOSPITAL_ID"
   Sp = Split(Range("B2"), " ")
     Hd1 = Sp(0): Hd2 = Mid(Range("B2"), Len(Sp(0)) + 2)
       c = 1
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Value, " ")
    [COLOR="Navy"]If[/COLOR] Not .Exists(Sp(UBound(Sp))) [COLOR="Navy"]Then[/COLOR]
        .Add Sp(UBound(Sp)), Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Sp(UBound(Sp))) = Union(.Item(Sp(UBound(Sp))), Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] .Item(K)
        Sp = Split(R, " ")
            [COLOR="Navy"]If[/COLOR] InStr(R, "*") <> 0 [COLOR="Navy"]Then[/COLOR]
                Num = Replace(Sp(0), "*", "")
            [COLOR="Navy"]Else[/COLOR]
               nSp = Split(R.Offset(, 1).Value & " " & R.Offset(, 2).Value, " ")
                c = c + 1
                ray(c, 1) = c - 1
                ray(c, 2) = Num & Val(Sp(0))
                ray(c, 3) = K
                ray(c, 4) = nSp(0)
                ray(c, 5) = CDate(nSp(1))
                ray(c, 6) = nSp(2)
                ray(c, 7) = Sp(1)
                ray(c, 8) = Hd2
                ray(c, 9) = Hd1
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet9").Range("A1").Resize(c, 9)
    .Value = ray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

MickG · Sep 10, 2017

Just a Note :-
Change the line below (at bottom of code) to "Sheet2" from "sheet9".

Code:

With  Sheets("Sheet2").Range("A1").Resize(c, 9)

KokoroAyo · Sep 10, 2017

Thank you very much Mick for your quick response.

However, I could not get it to run as it returns "Runtime Error '9'. Subscript out of range.

And the above error refers to Line 7:
Sp = Split(Range("B2"), " ")Thank you once again.

MickG · Sep 11, 2017

Try this example file:-
https://app.box.com/s/t850b18y1iuo4jt9fd3aevr64d8izrwu

KokoroAyo · Sep 12, 2017

Please one more thing. I have tried to tweak the code to loop through the full list without success. It has been difficult getting the loop right. You help is highly appreciated.

Please take a look at the full workbook from where I extracted the sample here:
https://www.4shared.com/office/7El_xePWca/ENROLEE_LIST.html

Thank you once again.

KokoroAyo · Sep 12, 2017

KokoroAyo said:
Please one more thing. I have tried to tweak the code to loop through the full list without success. It has been difficult getting the loop right. You help is highly appreciated.

Please take a look at the full workbook from where I extracted the sample here:
https://www.4shared.com/office/7El_xePWca/ENROLEE_LIST.html

Thank you once again.

Thank you Mick. The code worked like charm. I am really grateful for this.

MickG · Sep 12, 2017

You're welcome
If you still want me to look at your file please post file use Box.com.

KokoroAyo · Sep 12, 2017

MickG said:
You're welcome
If you still want me to look at your file please post file use Box.com.

Thank you for your support so far.

Please see the link to the file here:
https://app.box.com/s/70kavj40ppke5ebtgb8ata1w9wula2z2

Copy excel entries into new work sheet and rearrange the values

KokoroAyo

New Member

Excel Facts

KokoroAyo

New Member

MickG

MrExcel MVP

MickG

MrExcel MVP

KokoroAyo

New Member

MickG

MrExcel MVP

KokoroAyo

New Member

KokoroAyo

New Member

MickG

MrExcel MVP

KokoroAyo

New Member

Similar threads

Forum statistics

Share this page

Copy excel entries into new work sheet and rearrange the values

New Member

Excel Facts

New Member

MrExcel MVP

MrExcel MVP

New Member

MrExcel MVP

New Member

New Member

MrExcel MVP

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock