1st attempt vba-how do i whatnext in this sub

[ALAN EMERY]

hi all
My 1st attempt at vba and i am stuck
I have approx 60000 rows to process
As you can see program find the word material and then copies and paste
various cell onto sheet two, when it reads the cell content to be 9998 it
jump out of the loop.This work brillantly but I need it to now look for the
second occurance of the word material and process that position. then fourth
occurances ect untill all occurance of the word material has been
done.thanks in advance for any help

Sub Find_First()


Dim FindString As String
Dim Rng As Range
Sheets("Sheet1").Select
FindString = ("MATERIAL")
If Trim(FindString) <> "" Then
Set Rng = Range("A:A").Find(What:=FindString, _
After:=Range("A" & Rows.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then Application.Goto Rng, True
End If
Application.ScreenUpdating = False
'Sheets("Sheet1").Select
'Range("b8").Select
ActiveCell.Activate
ActiveCell.Offset(rowOffset:=0, columnOffset:=2).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("f" & finalrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=2, columnOffset:=0).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("g" & finalrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=0, columnOffset:=8).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("h" & finalrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=5, columnOffset:=-6).Activate
Do Until n = 80
If Selection.Value = ("9998") Then n = 80
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("A" & finalrow + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=0, columnOffset:=5).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("B" & finalrow + 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=3, columnOffset:=0).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("C" & finalrow + 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("D" & finalrow + 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=-4, columnOffset:=2).Activate
Selection.Copy
Sheets("Sheet2").Select
finalrow = Range("a65536").End(xlUp).Row
Range("E" & finalrow + 0).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveCell.Offset(rowOffset:=5, columnOffset:=-7).Activate
ActiveCell.Select
Loop
Application.ScreenUpdating = True
Sheets("Sheet2").Select

End Sub

 

[Tom Ogilvy]

Look in Excel VBA help at the FindNext method and the VBA sample/example
shows you how to do that.

An easier way would be to set up an advanced filter and have it copy to
another location. If using xl2000 or earlier, you have to start the process
from the destination sheet to get it to work. Even though Excel will
complain, it will work.

So you don't need a macro at all, but if you want one, you can turn on the
macro recorder while you do it manually.

the advanced filter is found under the Data menu. You have to set up a
criteria range which would have the column name for the column containing
Matrial and then in the next cell down, the word Material.

Assume Material is in column A and A1 has a header like TYPE


then your criteria range might be

M2: TYPE
M3: Material