Loop through sheet, look for specific value, paste

Question

People take a survey and their responses end up in one row in an Excel spreadsheet. People take multiple surveys, so their responses are spread throughout multiple worksheets. These people have IDs they use before every survey.

I want to loop through rows in each worksheet and copy select cells from the row with a particular person's survey responses. The assumption is the person pulling responses together into one spreadsheet knows the ID.

What I have so far is this:

Sub CreateSPSSFeed()

Dim StudentID As String  ' (StudentID is a unique identifier)
Dim Tool As Worksheet    ' (this is the worksheet I'm pulling data into)
Dim Survey1 As Worksheet ' (this is the sheet I'm pulling data from)
Dim i As Integer         ' (loop counter)

Tool = ActiveWorkbook.Sheets("ToolSheet")
Survey1 = ActiveWorkbook.Sheets("Survey1Sheet")

' (This is how the loop knows what to look for)
StudentID = Worksheet("ToolSheet").Range("A2").Value 

ActiveWorksheet("Survey1").Select ' (This loop start with the Survey1 sheet)
For i = 1 to Rows.Count ' (Got an overflow error here)
    If Cells (i, 1).Value = StudentID Then
        '!Unsure what to do here-- need the rest of the row
        ' with the matching StudentID copied and pasted
        ' to a specific row in ToolSheet, let's say starting at G7!
    End If
Next i

End Sub

I definitely don't intend for anyone to do the work for me. I've tried researching concepts and language here and haven't had a lot of luck combining loops with moving across sheets.

Answer 1

This one's not good, but may get you going:

Sub CreateSPSSFeed()

Dim StudentID As String '(StudentID is a unique identifier)
Dim Tool As Worksheet '(this is the worksheet I'm pulling data into)
Dim Survey1 As Worksheet '(this is the sheet I'm pulling data from)
'Dim i As Integer '(loop counter)    'You don't need to define it

Set Tool = ActiveWorkbook.Worksheets("ToolSheet") 'you'll need to use the Set command, don't ask why
Set Survey1 = ActiveWorkbook.Worksheets("Survey1Sheet")

ToolLastRow = Tool.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'so you won't need to loop through a million rows each time
Survey1LastRow = Survey1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Survey1LastColumn = Survey1.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

For j = 2 To ToolLastRow 'For each student ID from A2 down on toolsheet
    StudentID = Tool.Cells(j, 1).Value2 '(This is how the loop knows what to look for) 'why define it if you don't use it

    'ActiveWorksheet("Survey1").Select '(This loop start with the Survey1 sheet) 'Activeworksheet -> Activeworkbook but unnecessary,see below
    For i = 1 To Survey1LastRow '(Got an overflow error here)  'you won't get an overflow error anymore
        If Cells(i, 1).Value2 = StudentID Then
            '!Unsure what to do here--need the rest of the row with the matching StudentID copied and pasted to a specific row in ToolSheet, let's say starting at G7!
            'let's put the data starting at survey1's B# to the cells starting at tool's G#
            For k = 2 To Survey1LastColumn '2 refers to B, note the difference between B=2 and G=7 is 5
                Tool.Cells(j, k + 5) = Survey1.Cells(i, k)
            Next k
        End If
    Next i
Next j

End Sub

Answer 2

Try this:

Sub CreateSPSSFeed()

Dim StudentID As String '(StudentID is a unique identifier)
Dim rng as Range  
StudentID = Worksheet("ToolSheet").Range("A2").Value 'if you get error try to add Set = StudentID.....
j = 7
for x = 2 to sheets.count
 For i = 1 to Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row 'last not empty row

  If sheets(x).Cells (i, 1).Value = StudentID Then
   sheets(x).range(cells(i, 2),cells(i, 6)).copy _'adapt range to your needs
   Destination:=activesheet.Cells(j, 7) 'this is G7

   j = j + 1
  End If
 Next i
next x
End Sub

Run this code only from sheet where you pooling data into "Tool". Now you have nested loop for rows in loop for sheets. PS: no need to copy entire row, just range with value, to avoid errors.

Answer 3

This will check rows 1:500 (can easily change to entire column or different range) in all sheets in the workbook that starts with 'Survey' and paste to the tool sheet. Ensure you have enough space between student id's on the toolsheet to paste all possible occurrences.

The FIND method is from here: https://msdn.microsoft.com/en-us/library/office/ff839746.aspx

Sub CreateSPSSFeed()

    Dim sStudentID As String
    Dim shtTool As Worksheet
    Dim rFoundCell As Range
    Dim sFirstFound As String
    Dim rPlacementCell As Range
    Dim lCountInToolSheet As Long
    Dim wrkSht As Worksheet

    'Set references.
    With ActiveWorkbook
        Set shtTool = .Worksheets("ToolSheet")
        sStudentID = .Worksheets("ToolSheet").Cells(2, 1).Value
    End With

    'Find where the required student id is in the tool sheet.
    With shtTool.Range("A:A")
        'Will start looking after second row (as this contains the number you're looking for).
        Set rPlacementCell = .Find(sStudentID, After:=.Cells(3), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)

        'If the Student ID doesn't appear in column A it
        'will find it in cell A2 which we don't want.
        If rPlacementCell.Address = .Cells(2).Address Then

            'Find the last row on the sheet containing data -
            'two rows below this will be the first occurence of our new Student ID.
            lCountInToolSheet = .Find("*", After:=.Cells(1), SearchDirection:=xlPrevious).Row + 2

        'An existing instance of the number was found, so count how many times it appears (-1 for the instance in A2)
        Else
            lCountInToolSheet = WorksheetFunction.CountIf(shtTool.Range("A:A"), sStudentID) - 1
        End If

        'This is where our data will be placed.
        Set rPlacementCell = rPlacementCell.Offset(lCountInToolSheet)
    End With

    'Look at each sheet in the workbook.
    For Each wrkSht In ActiveWorkbook.Worksheets

        'Only process if the sheet name starts with 'Survey'
        If Left(wrkSht.Name, 6) = "Survey" Then

            'Find each occurrence of student ID in the survey sheet and paste to the next available row
            'in the Tool sheet.
            With wrkSht.Range("A1:A500")
                Set rFoundCell = .Find(sStudentID, LookIn:=xlValues, LookAt:=xlWhole)
                If Not rFoundCell Is Nothing Then
                    sFirstFound = rFoundCell.Address
                    Do
                        'Copy the whole row - this could be updated to look for the last column containing data.
                        rFoundCell.EntireRow.Copy Destination:=rPlacementCell
                        Set rPlacementCell = rPlacementCell.Offset(1)
                        Set rFoundCell = .FindNext(rFoundCell)
                    Loop While Not rFoundCell Is Nothing And rFoundCell.Address <> sFirstFound
                End If
            End With
            Set rFoundCell = Nothing
        End If
    Next wrkSht

End Sub

Edit: I've added more comments and extra code as realised the first section would always find the Student ID that is placed in cell A2.