find next and loop combined
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) :banghead: 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
Help is on the way - Part 1
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:
- 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.
- 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.
Please provide a specific example
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).