Thanks Thanks:  0
Likes Likes:  0
Results 1 to 5 of 5

Thread: Loop Until Question

  1. #1
    Board Regular
    Join Date
    Feb 2002
    Location
    Chicago, IL USA
    Posts
    306
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    I have a loop set up to Loop Unitl c = "". However, there are 20,000 reocrds and its taking a long time. So I have sorted them by the "c" value.

    How can I rewrite this loop to Loop Until c in different?

    Here's the full macro:
    Sub ProductServiceBoth()
    Application.ScreenUpdating = False
    Dim FirstValue, SecondValue, LastAddress, ThirdValue As String
    Dim Cel As Range
    Dim c As Object
    For Each Cel In Selection
    Set c = Worksheets("Sheet2").Columns("A:A").Find(Worksheets("Sheet1").Range(Cel.Address).Value, LookIn:=xlWhole, SearchOrder:=xlByColumns)
    FirstValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
    Set c = Worksheets("Sheet2").Columns("A:A").FindNext(c)
    SecondValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
    If FirstValue <> SecondValue Then
    Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
    GoTo 1
    Else:
    Do
    Set c = Worksheets("Sheet2").Columns("A:A").FindNext(c)
    ThirdValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
    If FirstValue <> ThirdValue Then
    Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
    GoTo 1
    End If
    Loop Until c = ""
    End If
    1 Cel.Interior.ColorIndex = 6
    Next Cel
    Application.ScreenUpdating = True
    MsgBox ("Done!")

    Thanks


  2. #2
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Create a new variable called PrevC. Set that equal to the c value. Then do your loop until PrevC<>c

    Best regards,
    Allan Chara
    http://www.mrspreadsheets.com

  3. #3
    Board Regular
    Join Date
    Feb 2002
    Location
    Chicago, IL USA
    Posts
    306
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hello again Al,

    I changed the end of the code as follows and am getting an "Overflow" error. The debug leads me to the following line of code:

    PrevC = Worksheets("Sheet2").Range(c.Address).Value

    FYI - I Dim'd CurrC & PrevC as Integers at the begining of the code.

    Do
    CurrC = Worksheets("Sheet2").Range(c.Address).Value
    Set c = Worksheets("Sheet2").Columns("A:A").FindNext(c)
    PrevC = Worksheets("Sheet2").Range(c.Address).Value
    ThirdValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
    If FirstValue <> ThirdValue Then
    Worksheets("Sheet1").Range(Cel.Address).Offset(0, 3).Value = "Both"
    GoTo 1
    End If
    Loop Until CurrC <> PrevC
    End If
    1 Cel.Interior.ColorIndex = 6
    Next Cel
    Application.ScreenUpdating = True
    MsgBox ("Done!")
    End Sub



    [ This Message was edited by: Adrae on 2002-04-05 11:54 ]

  4. #4
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Can you email me a copy of your workbook?

    awchara@aol.com

  5. #5
    MrExcel MVP Al Chara's Avatar
    Join Date
    Feb 2002
    Location
    Newark, Delaware
    Posts
    1,701
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Ok, I think I got it for you. Try the following:

    Application.ScreenUpdating = False
    Dim FirstValue, SecondValue, FirstAddress, CheckAddress, ThirdValue As String
    Dim Cel As Range
    Dim c As Object
    For Each Cel In Selection
    Set c = Worksheets("Sheet2").Columns("A:A").Find(Cel.Value, LookIn:=xlWhole, SearchOrder:=xlByColumns)
    FirstAddress = c.Address
    FirstValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
    Set c = Worksheets("Sheet2").Columns("A:A").FindNext(c)
    SecondValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
    If FirstValue <> SecondValue Then
    Cel.Offset(0, 3).Value = "Both"
    GoTo 1
    Else:
    Do
    Set c = Worksheets("Sheet2").Columns("A:A").FindNext(c)
    CheckAddress = c.Address
    ThirdValue = Worksheets("Sheet2").Range(c.Address).Offset(0, 3).Value
    If FirstValue <> ThirdValue Then
    Cel.Offset(0, 3).Value = "Both"
    GoTo 1
    End If
    Loop Until FirstAddress = CheckAddress
    End If
    1 Cel.Interior.ColorIndex = 6
    Next Cel
    Application.ScreenUpdating = True
    MsgBox ("Done!")
    Best regards,
    Allan Chara
    http://www.mrspreadsheets.com

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •