Use macro to check a range of cells within a row and copy wanted data to new sheet

[busspeed]

I have a problem and am not very familiar with VBA.
What I need to do is check a row of data one at a time (there are abou
3000 total rows) looking for a class number (the class numbers are i
different columns within the row). When I find that class number withi
the row I need to *copy* the row to another sheet. I am simply trying t
grab all of the students in certain classes and paste them on anothe
sheet.

Here is a sample of the data:
Adams gadams21 041184 84022 84260
Adams hadams4 111591 83772
Adams dadams25 041645 84020 84282
Adams madams3 082981 83969
Adams sadams9 120369 81838 84025 86460

The first column is last name (yes, I have changed the data...none o
it is sensitive).
The second column is user name.
3rd column is birthday.
Remaining columns are classes they are in (can vary; some can be in
classes, some in 1).

Any help would be greatly appreciated.

Thanks,

busspee

 

[Bernie Deitrick]

bus,

MACRO

You can use a macro - the macro below will extract all the data for a
particular class code and copy it to a new worksheet.

MANUAL

The manual method that depends on one additional column of formulas. Firts,
though, you will need a single cell for the class code that you want to
extract. Let's use A1 for our example.

Then use a column of formulas - in, let's say, column I, which I'll assume
to be blank: Enter this if cell I2:

=NOT(ISERROR(MATCH($A$1,A2:H2,FALSE)))

and copy that down to match your table.

Then use Data | Filter... Autofilter, and select the TRUE values of column
I. Then select your entire data table, use Edit | Go To... Special Visible
cells, then do your copy and paste to the new sheet.

HTH,
Bernie
MS Excel MVP

Sub FindClassCodeValues()
Dim c As Range ' The cell found with what you want
Dim d As Range ' All the cells found with what you want
Dim myFindString As String
Dim firstAddress As String
Dim mySht As Worksheet

myFindString = InputBox("Enter the class code", , "Hello")
With Cells
Set c = .Find(myFindString, LookIn:=xlValues, lookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
firstAddress = c.Address
Else:
MsgBox "Not Found"
End
End If

Set c = .FindNext(c)
If Not c Is Nothing And c.Address <> firstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
'Then all the rows of the cells that have been found

Set mySht = Worksheets.Add
mySht.Name = "Class " & myFindString
d.EntireRow.Copy mySht.Range("A1")

End Sub

 

[Tom Ogilvy]

Sub copyData
Dim rng as Range, lRow as Long
With .Columns("D:J")
set rng = .find(84022)
if not rng is nothing then
lRow = rng.row
do
rng.EntireRow.copy Destination:= _
worksheets("Sheet2").Cells(rows.count,1).End(xlup)(2)
set rng = .FindNext(rng)
Loop while rng.row <> lRow
End with

End Sub