Welcome Guest
Log In | Register )
You last visited December 7, 2016, 9:19 am
All times shown are
Eastern Time (GMT-5:00)

Does anyone know how to create a loop?

Topic closed. 9 replies. Last post 5 years ago by KnuckleHead.

Page 1 of 1
51
PrintE-mailLink
KnuckleHead's avatar - box

United States
Member #73037
April 3, 2009
147 Posts
Offline
Posted: January 20, 2012, 12:41 pm - IP Logged

Morning all,

Does anyone know how to take the below sub and create a loop with it?

Begin with this column of numbers:

0
1
3
3
3
4
4
6
6
8
8
9

End with this column of numbers:

0
1
3
4
6
8
9

Here's a sub I've created. All of the sections work, but I don't know how to create the loop to keep it running.

 

Sub Duplicate_Remover

'    This sub "removes" the "duplicate numbers" from a pre-selected "single row" range.
'
   
    'begin  loop here - "Begin-1"
   
'Begin_1:
' Check for an "Empty" cell.
    If Selection.CellDisplay = "" Then
        [].MoveCellPointer $Up,1
        Sendkeys "({END}{UP})", True    ' This line works for a single Unknown column of non-empty cells.
        [].MoveCellPointer $Right,1   
        [].MoveCellPointer $Left,1   
' IF the cell is "Empty" - then END the sub.
        End    ' Sub Quits Here
    Else
'
' Create two "Range Names" to work with.
        CurrentDocument.CreateRangeName "Remove_1", CurrentDocument.Selection     
        [].MoveCellPointer $Down,1
        CurrentDocument.CreateRangeName "Remove_2", CurrentDocument.Selection     
'
' Verify the two cells contents.
        If Remove_2 <> Remove_1        Then
' IF Remove_2 isn't the same as Remove_1...           
            CurrentDocument.DeleteRangeName "Remove_1"
            CurrentDocument.DeleteRangeName "Remove_2"
    'refer back to the beginning of the loop here- "Begin_1"
'            Goto Begin_1
           
        Else
' IF Remove_2 is the same as Remove_1...           
            Selection.DeleteRows $Partial
            CurrentDocument.DeleteRangeName "Remove_1"
            [].MoveCellPointer $Up,1
    'refer back to the beginning of the loop here- "Begin_1"
'            Goto Begin_1
           
        End If
    End If
End Sub

If anyone is able to assist with this, but you have more questions about how it works, please ask me.

Thanks ahead of time for any help.

          The only DUMB question is the one question you DID NOT ask...

    time*treat's avatar - radar

    United States
    Member #13130
    March 30, 2005
    2171 Posts
    Offline
    Posted: January 20, 2012, 5:19 pm - IP Logged

    Morning all,

    Does anyone know how to take the below sub and create a loop with it?

    Begin with this column of numbers:

    0
    1
    3
    3
    3
    4
    4
    6
    6
    8
    8
    9

    End with this column of numbers:

    0
    1
    3
    4
    6
    8
    9

    Here's a sub I've created. All of the sections work, but I don't know how to create the loop to keep it running.

     

    Sub Duplicate_Remover

    '    This sub "removes" the "duplicate numbers" from a pre-selected "single row" range.
    '
       
        'begin  loop here - "Begin-1"
       
    'Begin_1:
    ' Check for an "Empty" cell.
        If Selection.CellDisplay = "" Then
            [].MoveCellPointer $Up,1
            Sendkeys "({END}{UP})", True    ' This line works for a single Unknown column of non-empty cells.
            [].MoveCellPointer $Right,1   
            [].MoveCellPointer $Left,1   
    ' IF the cell is "Empty" - then END the sub.
            End    ' Sub Quits Here
        Else
    '
    ' Create two "Range Names" to work with.
            CurrentDocument.CreateRangeName "Remove_1", CurrentDocument.Selection     
            [].MoveCellPointer $Down,1
            CurrentDocument.CreateRangeName "Remove_2", CurrentDocument.Selection     
    '
    ' Verify the two cells contents.
            If Remove_2 <> Remove_1        Then
    ' IF Remove_2 isn't the same as Remove_1...           
                CurrentDocument.DeleteRangeName "Remove_1"
                CurrentDocument.DeleteRangeName "Remove_2"
        'refer back to the beginning of the loop here- "Begin_1"
    '            Goto Begin_1
               
            Else
    ' IF Remove_2 is the same as Remove_1...           
                Selection.DeleteRows $Partial
                CurrentDocument.DeleteRangeName "Remove_1"
                [].MoveCellPointer $Up,1
        'refer back to the beginning of the loop here- "Begin_1"
    '            Goto Begin_1
               
            End If
        End If
    End Sub

    If anyone is able to assist with this, but you have more questions about how it works, please ask me.

    Thanks ahead of time for any help.

    I don't know if this hurt to write, but it certainly hurt to read. Clown

    I avoid the macro recorder whenever possible. 

    Fast code can be hard to read, but hard to read code isn't always fast. Wink

     

    Thus:

    http://www.lotterypost.com/blogentry/62539 Cool

    In neo-conned Amerika, bank robs you.
    Alcohol, Tobacco, and Firearms should be the name of a convenience store, not a govnoment agency.

      KnuckleHead's avatar - box

      United States
      Member #73037
      April 3, 2009
      147 Posts
      Offline
      Posted: January 21, 2012, 11:34 am - IP Logged

      I don't know if this hurt to write, but it certainly hurt to read. Clown

      I avoid the macro recorder whenever possible. 

      Fast code can be hard to read, but hard to read code isn't always fast. Wink

       

      Thus:

      http://www.lotterypost.com/blogentry/62539 Cool

      Morning time*treat,

      I got the sub last night. It took me a little while to comprehend which were the input and output columns. Once understood, it works great for "0" to "9" numbers.

      Let me back up a bit. I have a file that contains several different games, from Pick 3 to Bonus games. I designed my sub to be "generic" so that it would work on different sheets and from different "beginning" locations. That's why there are no "cell" address in it. As long as the "calling" sub has positioned the cell pointer at the correct location when it's called, it works properly. Since I've never created a sub with a loop in it, I'm lost. If I "start" the sub and "step" thru it, then re-start and step again, it works as designed. Not having the experience of creating loops, I don't know what type of loop to use or where to place it. As my sub is designed, it doesn't matter what numbers are in the list, it only works on the 2 cells that are "Range-Named" at any given time. When it reaches a "blank" cell at the bottom of the list, it ends.

      Back to your Sub. It blazed thru the list in seconds. I'm looking at your code and attempting to figure out how to place the "generic" aspects of mine into what you're created so that it works as I originally envisioned. Your subs are working in memory (which is fantastic), mine works on keystrokes and recordings because I haven't figured out how to work in the memory.

      I very much appreciate the help. Thank you.

                The only DUMB question is the one question you DID NOT ask...

        JADELottery's avatar - MeAtWork 03.PNG
        The Quantum Master
        West Concord, MN
        United States
        Member #21
        December 7, 2001
        3675 Posts
        Offline
        Posted: January 22, 2012, 10:25 am - IP Logged

        You could try this. It will work for any value, decimal or integer.

        __________

        Dim arry() As Double

        Sub RemoveDuplicates()
           
            Randomize Timer
           
            Dim SelectedRange As String
            Dim RangeRowCount, r, i As Long
            SelectedRange = ActiveWindow.RangeSelection.Address
            RangeRowCount = Range(SelectedRange).Rows.Count
            ReDim arry(RangeRowCount) As Double
           
            For r = 1 To RangeRowCount
                arry(r) = Val(Range(SelectedRange).Cells(r, 1).Value)
            Next
           
            QuickSort 1, RangeRowCount
           
            Range(SelectedRange).Delete
           
            i = 0
            For r = 1 To (RangeRowCount - 1)
                If arry(r) <> arry(r + 1) Then
                    i = i + 1
                    Range(SelectedRange).Cells(i, 1).Value = arry(r)
                    If r = (RangeRowCount - 1) Then
                        i = i + 1
                        Range(SelectedRange).Cells(i, 1).Value = arry(r + 1)
                    End If
                End If
            Next r
           
        End Sub

        Sub QuickSort(ByVal Low As Long, ByVal High As Long) 'Borrowed and Modified from an old QuickBASIC 4.5 program.
            Dim RandIndex, i, j As Long
            Dim p As Double
            If Low < High Then
               If High - Low = 1 Then
                  If arry(Low) > arry(High) Then
                     SwapArrayElements Low, High
                  End If
               Else
                  RandIndex = RandInt(Low, High)
                  SwapArrayElements High, RandIndex
                  p = arry(High)
                  Do
                     i = Low: j = High
                     Do While (i < j) And (arry(i) <= p)
                        i = i + 1
                     Loop
                     Do While (j > i) And (arry(j) >= p)
                        j = j - 1
                     Loop
                     If i < j Then
                        SwapArrayElements i, j
                     End If
                  Loop While i < j
                  SwapArrayElements i, High
                  If (i - Low) < (High - i) Then
                     QuickSort Low, i - 1
                     QuickSort i + 1, High
                  Else
                     QuickSort i + 1, High
                     QuickSort Low, i - 1
                  End If
               End If
            End If
        End Sub

        Sub SwapArrayElements(ByVal a, ByVal b)
            Dim hold As Double
            hold = arry(a)
            arry(a) = arry(b)
            arry(b) = hold
        End Sub

        Function RandInt(ByVal Lower, ByVal Upper) As Long
           RandInt = Int(Rnd * (Upper - Lower + 1)) + Lower
        End Function

        __________

        Presented 'AS IS' and for Entertainment Purposes Only.
        Any gain or loss is your responsibility.
        Use at your own risk.

        Order is a Subset of Chaos
        Knowledge is Beyond Belief
        Wisdom is Not Censored
        Douglas Paul Smallish
        Jehocifer

          JADELottery's avatar - MeAtWork 03.PNG
          The Quantum Master
          West Concord, MN
          United States
          Member #21
          December 7, 2001
          3675 Posts
          Offline
          Posted: January 22, 2012, 11:10 am - IP Logged

          did a copy and paste the the wrong code.

          the RemoveDuplicates sub has an error, see correction below.

          __________

          Sub RemoveDuplicates()
             
              Randomize Timer
             
              Dim SelectedRange As String
              Dim RangeRowCount, r, i As Long
              SelectedRange = ActiveWindow.RangeSelection.Address
              RangeRowCount = Range(SelectedRange).Rows.Count
              ReDim arry(RangeRowCount) As Double
             
              For r = 1 To RangeRowCount
                  arry(r) = Val(Range(SelectedRange).Cells(r, 1).Value)
              Next
             
              QuickSort 1, RangeRowCount
             
              Range(SelectedRange).Delete
             
              i = 0
              For r = 1 To (RangeRowCount - 1)
                  If arry(r) <> arry(r + 1) Then
                      i = i + 1
                      Range(SelectedRange).Cells(i, 1).Value = arry(r)
                  End If
                  If r = (RangeRowCount - 1) Then
                      i = i + 1
                      Range(SelectedRange).Cells(i, 1).Value = arry(r + 1)
                  End If
              Next r

          End Sub

          __________

          Presented 'AS IS' and for Entertainment Purposes Only.
          Any gain or loss is your responsibility.
          Use at your own risk.

          Order is a Subset of Chaos
          Knowledge is Beyond Belief
          Wisdom is Not Censored
          Douglas Paul Smallish
          Jehocifer

            JADELottery's avatar - MeAtWork 03.PNG
            The Quantum Master
            West Concord, MN
            United States
            Member #21
            December 7, 2001
            3675 Posts
            Offline
            Posted: January 22, 2012, 1:51 pm - IP Logged

            We'll post the complete, corrected code one more time just so you don't have to copy two different sections.

            __________

            Dim arry() As Double

            Sub RemoveDuplicates()
               
                Randomize Timer
               
                Dim SelectedRange As String
                Dim RangeRowCount, r, i As Long
                SelectedRange = ActiveWindow.RangeSelection.Address
                RangeRowCount = Range(SelectedRange).Rows.Count
                ReDim arry(RangeRowCount) As Double
               
                For r = 1 To RangeRowCount
                    arry(r) = Val(Range(SelectedRange).Cells(r, 1).Value)
                Next
               
                QuickSort 1, RangeRowCount
               
                Range(SelectedRange).Delete
               
                i = 0
                For r = 1 To (RangeRowCount - 1)
                    If arry(r) <> arry(r + 1) Then
                        i = i + 1
                        Range(SelectedRange).Cells(i, 1).Value = arry(r)
                    End If
                    If r = (RangeRowCount - 1) Then
                        i = i + 1
                        Range(SelectedRange).Cells(i, 1).Value = arry(r + 1)
                    End If
                Next r

            End Sub

            Sub QuickSort(ByVal Low As Long, ByVal High As Long) 'Borrowed and Modified from an old QuickBASIC 4.5 program.
                Dim RandIndex, i, j As Long
                Dim p As Double
                If Low < High Then
                   If High - Low = 1 Then
                      If arry(Low) > arry(High) Then
                         SwapArrayElements Low, High
                      End If
                   Else
                      RandIndex = RandInt(Low, High)
                      SwapArrayElements High, RandIndex
                      p = arry(High)
                      Do
                         i = Low: j = High
                         Do While (i < j) And (arry(i) <= p)
                            i = i + 1
                         Loop
                         Do While (j > i) And (arry(j) >= p)
                            j = j - 1
                         Loop
                         If i < j Then
                            SwapArrayElements i, j
                         End If
                      Loop While i < j
                      SwapArrayElements i, High
                      If (i - Low) < (High - i) Then
                         QuickSort Low, i - 1
                         QuickSort i + 1, High
                      Else
                         QuickSort i + 1, High
                         QuickSort Low, i - 1
                      End If
                   End If
                End If
            End Sub

            Sub SwapArrayElements(ByVal a, ByVal b)
                Dim hold As Double
                hold = arry(a)
                arry(a) = arry(b)
                arry(b) = hold
            End Sub

            Function RandInt(ByVal Lower, ByVal Upper) As Long
               RandInt = Int(Rnd * (Upper - Lower + 1)) + Lower
            End Function

            __________

            Presented 'AS IS' and for Entertainment Purposes Only.
            Any gain or loss is your responsibility.
            Use at your own risk.

            Order is a Subset of Chaos
            Knowledge is Beyond Belief
            Wisdom is Not Censored
            Douglas Paul Smallish
            Jehocifer

              KnuckleHead's avatar - box

              United States
              Member #73037
              April 3, 2009
              147 Posts
              Offline
              Posted: January 22, 2012, 8:03 pm - IP Logged

              Hello JADELottery,

              Thank you for the reply and the code.

              Not being an experienced Excel user, I may have placed the coding incorrectly. I created 5 user modules in the "This Workbook" section of the VBA editor and pasted each of the 5 sets into a separate module. After saving the file, I attempted to "run" the"RemoveDuplicates" Sub. It popped up a message box titled "Microsoft Visual Basic for Application" box.

              The message reads: Complile error: Sub or Function not defined.

              The problem is in the QuickSort Sub. This line is the problem: If arry(Low) > arry(High) Then

              Knowing how well your code normally works, I'm sure I did something incorrectly. Any suggestions or directions would be greatly appreciated.

              Thanks again for the hard work.

                        The only DUMB question is the one question you DID NOT ask...

                JADELottery's avatar - MeAtWork 03.PNG
                The Quantum Master
                West Concord, MN
                United States
                Member #21
                December 7, 2001
                3675 Posts
                Offline
                Posted: January 22, 2012, 8:25 pm - IP Logged

                Hello JADELottery,

                Thank you for the reply and the code.

                Not being an experienced Excel user, I may have placed the coding incorrectly. I created 5 user modules in the "This Workbook" section of the VBA editor and pasted each of the 5 sets into a separate module. After saving the file, I attempted to "run" the"RemoveDuplicates" Sub. It popped up a message box titled "Microsoft Visual Basic for Application" box.

                The message reads: Complile error: Sub or Function not defined.

                The problem is in the QuickSort Sub. This line is the problem: If arry(Low) > arry(High) Then

                Knowing how well your code normally works, I'm sure I did something incorrectly. Any suggestions or directions would be greatly appreciated.

                Thanks again for the hard work.

                Discovered another little quirk, but it should not affect the results too drastically.

                Also, make sure you are copying and pasting all the lines of code, from  Dim arry() As Double  to  End Function

                It might be the version of Excel as well that could be affecting the code run.

                Or you can download the test file here -> http://www.jadexcode.com/RemoveDuplicatesTest.xls

                I don't work with Excel VB that much either, just learned some of this yesterday and today.

                __________

                Dim arry() As Double

                Sub RemoveDuplicates()
                   
                    Randomize Timer
                   
                    Dim SelectedRange As String
                    Dim RangeRowCount, r, i As Long
                    SelectedRange = ActiveWindow.RangeSelection.Address
                    RangeRowCount = Range(SelectedRange).Rows.Count
                    ReDim arry(RangeRowCount) As Double
                   
                    For r = 1 To RangeRowCount
                        arry(r) = Val(Range(SelectedRange).Cells(r, 1).Value)
                    Next
                   
                    QuickSort 1, RangeRowCount
                   
                    Range(SelectedRange).Clear
                   
                    i = 0
                    For r = 1 To (RangeRowCount - 1)
                        If arry(r) <> arry(r + 1) Then
                            i = i + 1
                            Range(SelectedRange).Cells(i, 1).Value = arry(r)
                        End If
                        If r = (RangeRowCount - 1) Then
                            i = i + 1
                            Range(SelectedRange).Cells(i, 1).Value = arry(r + 1)
                        End If
                    Next r

                End Sub

                Sub QuickSort(ByVal Low As Long, ByVal High As Long) 'Borrowed and Modified from an old QuickBASIC 4.5 program.
                    Dim RandIndex, i, j As Long
                    Dim p As Double
                    If Low < High Then
                       If High - Low = 1 Then
                          If arry(Low) > arry(High) Then
                             SwapArrayElements Low, High
                          End If
                       Else
                          RandIndex = RandInt(Low, High)
                          SwapArrayElements High, RandIndex
                          p = arry(High)
                          Do
                             i = Low: j = High
                             Do While (i < j) And (arry(i) <= p)
                                i = i + 1
                             Loop
                             Do While (j > i) And (arry(j) >= p)
                                j = j - 1
                             Loop
                             If i < j Then
                                SwapArrayElements i, j
                             End If
                          Loop While i < j
                          SwapArrayElements i, High
                          If (i - Low) < (High - i) Then
                             QuickSort Low, i - 1
                             QuickSort i + 1, High
                          Else
                             QuickSort i + 1, High
                             QuickSort Low, i - 1
                          End If
                       End If
                    End If
                End Sub

                Sub SwapArrayElements(ByVal a, ByVal b)
                    Dim hold As Double
                    hold = arry(a)
                    arry(a) = arry(b)
                    arry(b) = hold
                End Sub

                Function RandInt(ByVal Lower, ByVal Upper) As Long
                   RandInt = Int(Rnd * (Upper - Lower + 1)) + Lower
                End Function

                __________

                Presented 'AS IS' and for Entertainment Purposes Only.
                Any gain or loss is your responsibility.
                Use at your own risk.

                Order is a Subset of Chaos
                Knowledge is Beyond Belief
                Wisdom is Not Censored
                Douglas Paul Smallish
                Jehocifer

                  KnuckleHead's avatar - box

                  United States
                  Member #73037
                  April 3, 2009
                  147 Posts
                  Offline
                  Posted: January 22, 2012, 9:04 pm - IP Logged

                  Evening JADELottery,

                  I downloaded the "test" file and discovered that the entire code should have been placed into 1 module instead of 5 different modules. I setup a test range for each of the different sheets. It initially threw me on the 1st test when only the "0" disappeared. Then I pre-selected the range and tried again. It worked on all of the different examples.

                  Cool.

                  I still don't understand how to setup the loop I was originally working on, but this sub works great. And it does so in the memory.

                  Now, why is it setup in 1 module instead of 5 different modules? I was under the impression that the operating Sub would call whatever other sub's or function's from the different modules and they would all work together. It must be something to do with Excel that I didn't comprehend... (I'm switching over from Lotus 123 and Excel is kicking my posterior. So many things are the same, yet, so many differences to understand and work around.)

                  Anyway, thank you again for the sub. It works great.

                            The only DUMB question is the one question you DID NOT ask...

                    KnuckleHead's avatar - box

                    United States
                    Member #73037
                    April 3, 2009
                    147 Posts
                    Offline
                    Posted: January 24, 2012, 2:27 pm - IP Logged

                    Morning all,

                    Does anyone know how to take the below sub and create a loop with it?

                    Begin with this column of numbers:

                    0
                    1
                    3
                    3
                    3
                    4
                    4
                    6
                    6
                    8
                    8
                    9

                    End with this column of numbers:

                    0
                    1
                    3
                    4
                    6
                    8
                    9

                    Here's a sub I've created. All of the sections work, but I don't know how to create the loop to keep it running.

                     

                    Sub Duplicate_Remover

                    '    This sub "removes" the "duplicate numbers" from a pre-selected "single row" range.
                    '
                       
                        'begin  loop here - "Begin-1"
                       
                    'Begin_1:
                    ' Check for an "Empty" cell.
                        If Selection.CellDisplay = "" Then
                            [].MoveCellPointer $Up,1
                            Sendkeys "({END}{UP})", True    ' This line works for a single Unknown column of non-empty cells.
                            [].MoveCellPointer $Right,1   
                            [].MoveCellPointer $Left,1   
                    ' IF the cell is "Empty" - then END the sub.
                            End    ' Sub Quits Here
                        Else
                    '
                    ' Create two "Range Names" to work with.
                            CurrentDocument.CreateRangeName "Remove_1", CurrentDocument.Selection     
                            [].MoveCellPointer $Down,1
                            CurrentDocument.CreateRangeName "Remove_2", CurrentDocument.Selection     
                    '
                    ' Verify the two cells contents.
                            If Remove_2 <> Remove_1        Then
                    ' IF Remove_2 isn't the same as Remove_1...           
                                CurrentDocument.DeleteRangeName "Remove_1"
                                CurrentDocument.DeleteRangeName "Remove_2"
                        'refer back to the beginning of the loop here- "Begin_1"
                    '            Goto Begin_1
                               
                            Else
                    ' IF Remove_2 is the same as Remove_1...           
                                Selection.DeleteRows $Partial
                                CurrentDocument.DeleteRangeName "Remove_1"
                                [].MoveCellPointer $Up,1
                        'refer back to the beginning of the loop here- "Begin_1"
                    '            Goto Begin_1
                               
                            End If
                        End If
                    End Sub

                    If anyone is able to assist with this, but you have more questions about how it works, please ask me.

                    Thanks ahead of time for any help.

                    Afternoon all,

                    To begin with, the column I want to remove the duplicates from is already sorted into an ascending order.

                    Below is a simple and elegant solution that I found in my e-mail. (I was told that my attempt was to complicated.)

                    Sub Duplicate_Remover
                      Do While Not Selection.CellDisplay = ""
                         Cell1 = .CellDisplay
                        .MoveCellPointer $Down,1
                        Cell2 = .CellDisplay
                        If Cell1 = Cell2 Then
                       .DeleteRows $Partial
                       .MoveCellPointer $Up,1
                       End If
                       Loop
                    End Sub

                    The sub is called from another sub and the cell pointer needs to be positioned at the first cell in the column.

                    I still have a use for the other subs in different locations. Thank you all for the help. I got to learn something new...

                              The only DUMB question is the one question you DID NOT ask...