find next and loop combined

[Nucor]

Here is my coding...this is my first post, so i'm assuming that it's ok to post code here...if not, SORRY !!!

[vba]Sub Macro2()
'
' This searches using the GL as the constant
'
Dim X As String


Sheets("Reports").Select
X = Range("H7").Value

Sheets("Input List").Select
Range("L11").Select

Cells.Find(What:=X, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate

ActiveCell.Activate
ActiveCell.Offset(0, -8).Activate 'QSR NUMBER
Selection.Copy

Sheets("Reports").Select 'COPY/PASTE QSR NUMBER

Range("B18").Select

empty_cell 'run empty cell routine

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Input List").Select
ActiveCell.Offset(0, 3).Activate 'TREND
Selection.Copy

Sheets("Reports").Select 'COPY/PASTE TREND
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Input List").Select
ActiveCell.Offset(0, 1).Activate 'OCCURENCE
Selection.Copy

Sheets("Reports").Select 'COPY/PASTE OCCURENCE
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Input List").Select
ActiveCell.Offset(0, 5).Activate 'COST
Selection.Copy

Sheets("Reports").Select 'COPY/PASTE COST
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Input List").Select
ActiveCell.Offset(0, 1).Activate 'DESCRIPTION
Selection.Copy

Sheets("Reports").Select 'COPY/PASTE DESCRIPTION
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Do
Do While ActiveCell.Text <> ""
ActiveCell.Offset(1, 0).Select
If ActiveCell.Text = "" Then
ActiveCell.Activate
End If
Loop
Loop Until ActiveCell.Text = ""


End Sub
[/vba] The loop is where i'm getting stuck. What i need the code to do, is search through a sheet (Input List is the name of the sheet), look for the text that is in a certain cell ( H7 of the Input List sheet), copy a certain range of cells, and then pastes it on the second sheet ( Reports is the name of the sheet), (here comes the problem) go back to the first sheet, start looking at the information again, copy and pasting ONLY the next row of cells that has the same value in H& from the input list sheet. this process will run till it hits the last row for input (row 1162) OR to make it faster, till there is a blank cell with no value in it.

Can ANYONE please help me ?!?!?!?!

Thanks in advance,
Nucor

[RolfJ]

Posting code is quite alright in this forum. However please use the VBA tags (by highlighting the code and then clicking on the VBA icon).

You are using the Activate and Select method unneccessarily often (I used to do that too, because the Macro Recorder does!). Therefore I am offering in Part 1 of my response a revised version of the first part of your code rewritten without a single call to these methods. I trust that you'll agree that this makes for more concise (and actually faster) code:

[vba]
Dim X As String
'Calling a variable X is generally not a good idea.
'I would recommend picking a more descriptive name.

Dim shReports As Worksheet, shInputList As Worksheet
Set shReports = Worksheets("Reports")
Set shInputList = Worksheets("Input List")

X = shReports.Range("H7").Value

Dim sourceCell As Range
Set sourceCell = shInputList.Cells.Find(What:=X, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Offset(, -8)

If sourceCell Is Nothing Then Exit Sub

Dim targetCell As Range
Set targetCell = shReports.Range("B18")

'COPY/PASTE QSR NUMBER
sourceCell.Copy
targetCell.PasteSpecial Paste:=xlPasteValues

'??? empty_cell 'run empty cell routine (YOU DIDN'T PASS ALONG THAT ROUTINE

'COPY/PASTE TREND
Set sourceCell = sourceCell.Offset(, 3)
sourceCell.Copy
targetCell.Offset(, 1).PasteSpecial Paste:=xlPasteValues

'COPY/PASTE OCCURENCE
Set sourceCell = sourceCell.Offset(, 1)
sourceCell.Copy
targetCell.Offset(, 2).PasteSpecial Paste:=xlPasteValues

'COPY/PASTE COST
Set sourceCell = sourceCell.Offset(, 5)
sourceCell.Copy
targetCell.Offset(, 3).PasteSpecial Paste:=xlPasteValues

'COPY/PASTE DESCRIPTION
Set sourceCell = sourceCell.Offset(, 1)
sourceCell.Copy
targetCell.Offset(, 4).PasteSpecial Paste:=xlPasteValues

[/vba]

Now I have a couple of questions:

1. You didn't post the 'empty_cell' routine you are invoking in your code. I suspect this is exactly the loop you are trying to create and are having difficulties with. Please clarify.
2. I am a bit fuzzy on what you are tying to do with that loop. Am I supposed to envision that you want to repeat the cell copy process I rewrote for you for each row that contains the value X in the cell in column H. Usually providing a specific example helps eliminating any confusion or misunderstanding.

[Nucor]

Thank you for your response....i will remember to use the vba tags next time...(thanks for the insite)

to answer your questions:
1) at the time of making this post, i hadn't wrote the "empty_cell" routine. I have completed writing that, so that isn't the issue.
2) Let me try to explain it this way (im an engineer...i do better if i could draw in on paper to show you, but i will try typing my thoughts. LOL)

your code just copied and pasted everything into a certian range of cells.
The loop will then start the process over from where it left off from the previous data so that it wont be copying over the same data each time.

think of it like this....
you have some playing cards laid out on a table. you have placed 5 rows of cards within each row, there is a heart, diamond, spade, and club in it.

What you're wanting to know, is the value of the "spades" only from each row.

so in row 1, you have the Jack of Spades;
(now that you know what is in row 1, you write it down on paper, then you go back to the rows, skip row 1, and look at row 2)
row 2 you have the Ace of Spades;
(now that you know what is in row 2, you write it down on paper, then you go back to the rows, skip rows 1 & 2, and look at row 3)
row 3 you have King of Spades;
(now that you know what is in row 3, you write it down on paper, then you go back to the rows, skip rows 1,2, & 3, and look at row 4)
row 4 you have the 10 of Spades;
(now that you know what is in row 4, you write it down on paper, then you go back to the rows, skip rows 1,2,3, & 4, and look at row 5)
and in row 5, you have the Queen of Spades.
(now that you know whats in row 5, you write it down on paper, then you go back to the rows, see that there isn't anymore rows to look at, so now you are finished)



Does that make sense?? lol, I'm really trying to explain myself the best i can....!

Thank you again,
Nucor

[rbrhodes]

Hi Nucor,

Straight from the VBA help files...and it works!

[vba]
Sub LookForX()
'Where to look
With Sheets("Input List").Range("L11:L" & Rows.Count)
'Find it
Set c = .Find(x, LookIn:=xlValues)
'If not Nothing then is something(was found)
If Not c Is Nothing Then
'Save address of first X found
firstAddress = c.Address
Do

'...all your code to copy etc goes here...

'Find next instance of X
Set c = .FindNext(c)
'Keep looking until we find the first instance of X again, then bail
Loop While Not c Is Nothing And c.Address <> firstAddress
'Not found at all will come here
End If
End With
End Sub

[/vba]

[RolfJ]

Why don't you provide a specific example either in form of a sample workbook or by specifically spelling out the contents of the first 3 rows in the 'Input List' worksheet (i.e. the rows containing cells H7, H8 and H9 if I understand you correctky) and the first 3 rows of the copied cells you want to see in the 'Reports' worksheet (I guess that would be the rows containing the cells B18, B19 and B20).