| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
1st attempt vba-how do i whatnext in this sub
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
1st attempt vba-how do i whatnext in this sub
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 -- Regards, Tom Ogilvy "ALAN EMERY" wrote in message ... 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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Passed Exam in first attempt | New Users to Excel | |||
| Sumproduct - Second Attempt | Excel Worksheet Functions | |||
| 'of' percentage with calculation (attempt 2) | Excel Discussion (Misc queries) | |||
| First attempt at VBA coding problem | New Users to Excel | |||
| 2nd attempt at excel VB commands | Excel Programming | |||
Linear Mode
