Does anyone know how to create a loop?Previous TopicNext Topic

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.

I avoid the macro recorder whenever possible. 

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

Thus:

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

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.

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

__________

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

__________

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

__________

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

__________

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.

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...