Does anyone know how to create a loop?Prev Topic Next Topic

New Topic New Poll

KnuckleHead

United States
Member #73,035
April 3, 2009
147 Posts
Offline

Jan 20, 2012, 12:41 pm

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

United States
Member #13,130
March 30, 2005
2,171 Posts
Offline

Jan 20, 2012, 5:19 pm

Quote: Originally posted by KnuckleHead on Jan 20, 2012
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:

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

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

United States
Member #73,035
April 3, 2009
147 Posts
Offline

Jan 21, 2012, 11:34 am

Quote: Originally posted by time*treat on Jan 20, 2012
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:

https://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.

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

Native American Eagle Sun

MN
United States
Member #21
December 7, 2001
4,812 Posts
Offline

Jan 22, 2012, 10:25 am

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

__________

The One Over None
I Know...
JADELottery

Native American Eagle Sun

MN
United States
Member #21
December 7, 2001
4,812 Posts
Offline

Jan 22, 2012, 11:10 am

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

__________

The One Over None
I Know...
JADELottery

Native American Eagle Sun

MN
United States
Member #21
December 7, 2001
4,812 Posts
Offline

Jan 22, 2012, 1:51 pm

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

__________

The One Over None
I Know...
KnuckleHead

United States
Member #73,035
April 3, 2009
147 Posts
Offline

Jan 22, 2012, 8:03 pm

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

Native American Eagle Sun

MN
United States
Member #21
December 7, 2001
4,812 Posts
Offline

Jan 22, 2012, 8:25 pm

Quote: Originally posted by KnuckleHead on Jan 22, 2012
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

__________

The One Over None
I Know...
KnuckleHead

United States
Member #73,035
April 3, 2009
147 Posts
Offline

Jan 22, 2012, 9:04 pm

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

United States
Member #73,035
April 3, 2009
147 Posts
Offline

Jan 24, 2012, 2:27 pm

Quote: Originally posted by KnuckleHead on Jan 20, 2012
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...

New Topic New Poll

Subscribe to this topic

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

Does anyone know how to create a loop?Prev Topic Next Topic