ThePianoman
New Member
- Joined
- Mar 15, 2011
- Messages
- 15
I keep coming across the need for this macro in my work projects, so I would be very appreciate to anyone who can help.
I have a sheet containing multiple columns, multiple rows. Column A contains a research participants Subject ID#, and the rest of the rows contain data (gender, visit date, scores from a test, etc.). Each patient may have MULTIPLE rows of data (due to being evaluated on different dates, etc.
My problem is that I don't need the data from EVERY subject that we saw, just from a particular set of subjects. The list of IDs for which I need the data is listed in column A, sheet 3 starting in A2.
I need a Macro that will loop through all of the Subject IDs in column A of sheet 3, then find those subjects in sheet 1 column A (where all the data is stored), then copy the entire row containing that subject ID into sheet 2 on the next available row.
I have a semi-functional Macro that I pulled from another site, but the problem with it is that it won't copy more than 1 row for each subject. Again, each subject may have MULTIPLE rows of data. How do I modify this Macro to find and copy ALL rows containing each subject's ID instead of stopping and moving on to the next subject after finding only one? I would be so appreciative for some help today thanks!!
Option Explicit
Sub PatientFinder()
Dim srchLen, gName, nxtRw As Integer
Dim g As Range
'Clear Sheet 2 and Copy Column Headings
Sheets(2).Cells.ClearContents
Sheets(1).Rows(1).Copy Destination:=Sheets(2).Rows(1)
'Determine length of Search Column from Sheet3
srchLen = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
'Loop through list in Sheet3, Column A. As each value is
'found in Sheet1, Column A, copy it top the next row in Sheet2
With Sheets(1).Columns("A")
For gName = 2 To srchLen
Set g = .Find(Sheets(3).Range("A" & gName), lookat:=xlWhole)
If Not g Is Nothing Then
nxtRw = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
g.EntireRow.Copy Destination:=Sheets(2).Range("A" & nxtRw)
End If
Next
End Sub
I have a sheet containing multiple columns, multiple rows. Column A contains a research participants Subject ID#, and the rest of the rows contain data (gender, visit date, scores from a test, etc.). Each patient may have MULTIPLE rows of data (due to being evaluated on different dates, etc.
My problem is that I don't need the data from EVERY subject that we saw, just from a particular set of subjects. The list of IDs for which I need the data is listed in column A, sheet 3 starting in A2.
I need a Macro that will loop through all of the Subject IDs in column A of sheet 3, then find those subjects in sheet 1 column A (where all the data is stored), then copy the entire row containing that subject ID into sheet 2 on the next available row.
I have a semi-functional Macro that I pulled from another site, but the problem with it is that it won't copy more than 1 row for each subject. Again, each subject may have MULTIPLE rows of data. How do I modify this Macro to find and copy ALL rows containing each subject's ID instead of stopping and moving on to the next subject after finding only one? I would be so appreciative for some help today thanks!!
Option Explicit
Sub PatientFinder()
Dim srchLen, gName, nxtRw As Integer
Dim g As Range
'Clear Sheet 2 and Copy Column Headings
Sheets(2).Cells.ClearContents
Sheets(1).Rows(1).Copy Destination:=Sheets(2).Rows(1)
'Determine length of Search Column from Sheet3
srchLen = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
'Loop through list in Sheet3, Column A. As each value is
'found in Sheet1, Column A, copy it top the next row in Sheet2
With Sheets(1).Columns("A")
For gName = 2 To srchLen
Set g = .Find(Sheets(3).Range("A" & gName), lookat:=xlWhole)
If Not g Is Nothing Then
nxtRw = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
g.EntireRow.Copy Destination:=Sheets(2).Range("A" & nxtRw)
End If
Next
End Sub
