asked on

VB Looping in Excel

I have an excel worksheet with 30000 records. I need to write a macro that reads a store number from sheet 1 (i.e. in cell B1) and grabs all records that correspond with that store number. For example:

1 Help
1 Help
1 Help
2 Simpson
2 Simpson
2 Simpson
3 Fred
3 Fred

In this case, if I have store 2 entered in cell B1, I need the macro to pull only those records and copy them to sheet 2. What I have so far (that doesn't work):

Sub looptest()
Dim I As Integer
I = Sheets("sheet2").Range("B1:B1")
Sheets("Sheet1").Range("A1:A1").Select
Do While Not ActiveCell = I
Selection.Offset(1, 0).Select
Loop
Sheets("Sheet2").Select
Range("D1").Select
Sheets("Sheet1").Select
Do While ActiveCell = I
Range(ActiveCell, Selection.Offset(0, 2)).Select
Selection.Copy
Sheets("Sheet2").Select
Selection.Offset(1, 0).Select
Selection.Paste
Sheets("Sheet1").Select
Range(ActiveCell, Selection.Offset(0, 2)).Select
Selection.Offset(1, 0).Select
Loop
End Sub

PLEASE HELP!

Arthur_Wood

try this:

Sub looptest()
Dim I As Integer
I = Sheets("sheet2").Range("B1:B1").Value
Sheets("Sheet1").Range("A1:A1").Select
Do While Not ActiveCell.Value = I
Selection.Offset(1, 0).Select
Loop
Sheets("Sheet2").Select
Range("D1").Select
Sheets("Sheet1").Select
Do While ActiveCell.Value = I
Range(ActiveCell, Selection.Offset(0, 2)).Select
Selection.Copy
Sheets("Sheet2").Select
Selection.Offset(1, 0).Select
Selection.Paste
Sheets("Sheet1").Select
Range(ActiveCell, Selection.Offset(0, 2)).Select
Selection.Offset(1, 0).Select
Loop
End Sub

as you had it coded:

Sheets("sheet2").Range("B1:B1") returns a Range Object, not the Value if the Cell IN THAT RANGE. To get the VALUE of the selected RAANGE (cell in your case), you need to retrieve the .Value Property of the Range object (which returns the Value in the UPPER LEFT Cell, if there are more than 1 cell(s) in the Range).

AW

ASKER CERTIFIED SOLUTION

EDDYKT

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Dina-mic

ASKER

That didn't work either

Dina-mic

ASKER

THANKS EDDYKT! THAT WORKED! YOU ROCK!