• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 187
  • Last Modified:

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!
0
Dina-mic
Asked:
Dina-mic
  • 2
1 Solution
 
Arthur_WoodCommented:
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
0
 
EDDYKTCommented:
Try this


Sub looptest()
Dim I As Integer
I = Sheets("sheet2").Range("B1:B1")
Sheets("sheet1").Select
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
Range(ActiveCell, Selection.Offset(0, 2)).Select
Do While ActiveCell = I
   Selection.Copy
   Sheets("Sheet2").Select
   Selection.Offset(1, 0).Select
   ActiveSheet.Paste
   Sheets("Sheet1").Select
   Selection.Offset(1, 0).Select
Loop
End Sub
0
 
Dina-micAuthor Commented:
That didn't work either
0
 
Dina-micAuthor Commented:
THANKS EDDYKT!  THAT WORKED!  YOU ROCK!
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now