VBA to select a certain range of cells based on values in other cells and relative locations to them

[deadlock123]

Hello all!

So I have some consumer satisfaction survey data that is not organized at all - no headers. There's no header whatsoever as you can see below.

What I need is to separate the data by the service provider name (e.g., John Doe, Jane Doe). For example, select and copy all the survey data for John Doe (as seen below, from question 1 to question 4), and save it in a separate sheet named John Doe. And do that for many different people whose names appear on the sheet. Quite often, the same name re-appears throughout the sheet, e.g., the survey data for John Doe's other services will appear in the middle of the sheet.

I have the name list of the service providers. So I loop through this list to get each provider's name.

So my manual way was: use Find All for each provider to select the relevant rows - ranging from the three rows above the first occurrence of the name (the Service code: Name row) to the Thank you message row. And cut-paste it to another sheet titled the provider's name, go back to the original sheet and repeat the Find All - Cut Paste again for any other service of the same provider, until there's no remaining data left for the person. Then I'd know that I got all the data for that person. Then I move on to the next provider's name in the name list. And repeat the process.

I cannot help but thinking there should be a way to code this procedure. I just can't figure out how though.

There's a pattern indeed. For each service, first we see the Service Code: Name row, then quarter row, the provider's name row, the welcome message row, and then the survey questions and answer data rows - however many there are, and then finally Thank you message row. I'm imagining that there should be a way to slice these up for each service and aggregate them onto each provider's sheet.

Any tip or advice would be greatly appreciated. Thank you for your time!

Sample to ask .xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	PT1101: Physical Theraphy session
2	2021 Summer Quarter
3	John Doe
4	Please give us 5 minutes of your time to fill out this evaluation.
5
6	1) Please evaluate the service you received.
7	Statement	Strongly Disagree	Percent	Disagree	Percent	Neutral	Percent	Agree	Percent	Strongly Agree	Percent	Total	Average
8	Session started on time	0	0.00%	0	0.00%	0	0.00%	3	37.50%	5	62.50%	8	4.6
9	This service addressed my pain issues.	0	0.00%	0	0.00%	0	0.00%	3	37.50%	5	62.50%	8	4.6
10	…
11
12	2) I need technical support in navigating the scheduling system.
13	Yes	Percent	No	Percent	N/A	Percent	Total	Average
14	2	25.00%	4	50.00%	2	25.00%	8	1.7
15
16	3) Please evaluate the therapist below.
17	Therapist	Statement	Strongly Disagree	Percent	Disagree	Percent	Neutral	Percent	Agree	Percent	Strongly Agree	Percent	Total	Average
18	John Doe	The entire treatment plan was reviewed in the first session.	0	0.00%	0	0.00%	0	0.00%	2	25.00%	6	75.00%	8	4.8
19		Breaks were approximately 10 minutes/hr in length (e.g. 30 minutes total for a 3-hour class).	0	0.00%	0	0.00%	0	0.00%	3	37.50%	5	62.50%	8	4.6
20		…
21
22	4) What is the strength of this therapist?
23	Therapist	Answer
24	John Doe	very good
25		knowledge
26		Informative
27		Clear explanation!
28	…	…	…
29	Thank you in advance for your feedback!
30
31	WM1048: Work environment consulting
32	2021 Summer Quarter
33	Jane Doe
34	Please give us 5 minutes of your time to fill out this evaluation.
35
36	1) Please evaluate the service you received.
37	Statement	Strongly Disagree	Percent	Disagree	Percent	Neutral	Percent	Agree	Percent	Strongly Agree	Percent	Total	Average
38	Session started on time	0	0.00%	0	0.00%	0	0.00%	4	50.00%	4	50.00%	8	4.5
39	This service addressed my pain issues.	0	0.00%	0	0.00%	0	0.00%	4	50.00%	4	50.00%	8	4.5
40	…
41
42	2) I need technical support in navigating the scheduling system.
43	Yes	Percent	No	Percent	N/A	Percent	Total	Average
44	2	25.00%	4	50.00%	2	25.00%	8	1.7
45
46	3) Please evaluate the therapist below.
47	Therapist	Statement	Strongly Disagree	Percent	Disagree	Percent	Neutral	Percent	Agree	Percent	Strongly Agree	Percent	Total	Average
48	Jane Doe	The entire treatment plan was reviewed in the first session.	0	0.00%	0	0.00%	0	0.00%	2	25.00%	6	75.00%	8	4.8
49		Breaks were approximately 10 minutes/hr in length (e.g. 30 minutes total for a 3-hour class).	0	0.00%	0	0.00%	0	0.00%	3	37.50%	5	62.50%	8	4.6
50		…
51
52	4) What is the strength of this therapist?
53	Therapist	Answer
54	Jane Doe	not good
55		so so knowledge
56		Informative
57		Very friendly!
58
59	## Same pattern …##
60	## Many other services, some names reappear ##
Sample to ask

 

[tonyyy]

You might consider the following...

Sub SelectAndCopy()
Dim r As Range
Dim LastRow As Long
Dim firstAddress As String
Dim arr As Variant
Dim i As Long, kount As Long
Dim ws1 As Worksheet, ws2 As Worksheet

Application.ScreenUpdating = False
Set ws1 = Sheets(1)
LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
ReDim arr(1 To LastRow, 1 To 1)
i = 0
kount = 0

With ws1.Range("A1:A" & LastRow)
    Set r = .Find("Please give", LookIn:=xlValues)
    If Not r Is Nothing Then
        firstAddress = r.Address
        Do
            i = i + 1
            kount = kount + 1
            arr(i, 1) = r.Row
            Set r = .FindNext(r)
        Loop While firstAddress <> r.Address
    End If
End With
i = i + 1
arr(i, 1) = LastRow

For i = 1 To kount
    Set ws2 = ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))
    ws1.Activate
    If i < kount Then
        ws1.Range(Rows(arr(i, 1) - 3), Rows(arr(i + 1, 1) - 5)).Copy Destination:=ws2.Range("A1")
        ws2.Name = ws2.Cells(3, 1).Value & i
    Else
        ws1.Range(Rows(arr(i, 1) - 3), Rows(arr(i + 1, 1))).Copy Destination:=ws2.Range("A1")
        ws2.Name = ws2.Cells(3, 1).Value & i
    End If
Next i

Application.ScreenUpdating = True
End Sub

Cheers,

Tony