PDA

View Full Version : INFINITE LOOP PROBLEM!!!



dpalmer013
12-12-2013, 09:20 AM
I have an inifinite loop problem that requires urgent assistance. I've attached the spreadsheet with the data and the desired results.

Note: Actual data has been stripped due to confidentiality with a client.

Any help is much appreciated, thanks!!

snb
12-12-2013, 10:02 AM
Sub M_snb()
With Sheets("output before Macro").Columns(1)
Set sn = Sheets("output before Macro").Columns(1).SpecialCells(2, 2).Areas
.SpecialCells(4) = 0

For Each ar In sn
If ar.Rows.Count < 3 Then ar.Value = ""
Next

.SpecialCells(4).EntireRow.Delete
.SpecialCells(2, 1) = ""
End With
End Sub

Kenneth Hobs
12-12-2013, 10:34 AM
As a courtesy, you should post links to where you posted the same question. For the reasons why see: http://www.excelguru.ca/node/7

cross-posted to: http://www.excelforum.com/excel-programming-vba-macros/974806-infinite-looping-problem.html

dpalmer013
12-12-2013, 01:41 PM
Thanks Kenneth, I understand I was cross posting. My apologies for not including the link in the IP.

dpalmer013
12-12-2013, 01:45 PM
Of the two loop questions, one of them has been addressed; however, I still need help on the second.

I was attempting to replicate the following VBA for Loop1 in another section of my output using Loop2 but it's not working. This loop is definitely more lengthy than the one mentioned in the initial post, but it should still work if I'm using the same logic, right??



Sub Loop1()
Dim rgFind As Range
Dim sStart As String

Set rgFind = Cells.Find(What:="EERT OUTPUT", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)

If Not rgFind Is Nothing Then
sStart = rgFind.Address
Do
With rgFind
.Offset(4, 0).Range("A1:N2").Copy .Offset(1, 16)
.Offset(7, 0).Range("A1:M2").Copy .Offset(1, 30)
.Offset(10, 0).Range("A1:K2").Copy .Offset(1, 43)
.Offset(4).Resize(9).EntireRow.Delete
End With
Set rgFind = Cells.FindNext(rgFind)
Loop While rgFind.Address <> sStart
End If
End Sub



Sub Loop2()
Dim rgFind1 As Range
Dim sStart1 As String

Set rgFind1 = Cells.Find(What:="Document Number:", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)

If Not rgFind1 Is Nothing Then
sStart1 = rgFind1.Address
Do
With rgFind1
.Offset(2, 0).Range("A1").Cut .Offset(-1, 1)
.Offset(2, -1).Range("A1").Cut .Offset(-2, 2)
.Offset(2, -1).Range("A1").Cut .Offset(-1, 1)
.Offset(2, 3).Range("A1").Cut .Offset(-1, 1)
.Offset(2, -1).Range("A1").Cut .Offset(-2, 2)
.Offset(2, -1).Range("A1").Cut .Offset(-1, 1)
.Offset(2, -5).Range("A1").Cut .Offset(-3, 3)
.Offset(3, -2).Range("A1").Cut .Offset(-2, 2)
.Offset(3, -3).Range("A1").Cut .Offset(-4, 6)
.Offset(4, -5).Range("A1").Cut .Offset(-3, 5)
.Offset(3, -3).Range("A1").Cut .Offset(-4, 4)
.Offset(4, -3).Range("A1").Cut .Offset(-3, 3)
.Offset(5, -7).Range("A1").Cut .Offset(-6, 8)
.Offset(6, -7).Range("A1").Cut .Offset(-5, 7)
.Offset(7, -8).Range("A1").Cut .Offset(-8, 9)
.Offset(8, -8).Range("A1").Cut .Offset(-7, 8)
.Offset(8, -9).Range("A1").Cut .Offset(-9, 10)
.Offset(9, -9).Range("A1").Cut .Offset(-8, 9)
.Offset(9, -10).Range("A1").Cut .Offset(-10, 11)
.Offset(10, -10).Range("A1").Cut .Offset(-9, 10)
.Offset(10, -11).Range("A1").Cut .Offset(-11, 12)
.Offset(11, -11).Range("A1").Cut .Offset(-10, 11)
.Offset(7, -6).Range("A1").Cut .Offset(-8, 7)
.Offset(8, -6).Range("A1").Cut .Offset(-7, 6)
.Offset(8, -7).Range("A1").Cut .Offset(-9, 8)
.Offset(9, -7).Range("A1").Cut .Offset(-8, 7)
.Offset(9, -8).Range("A1").Cut .Offset(-10, 9)
.Offset(10, -8).Range("A1").Cut .Offset(-9, 8)
.Offset(7, -12).Range("A1").Cut .Offset(-8, 13)
.Offset(8, -12).Range("A1").Cut .Offset(-7, 12)
.Offset(8, -13).Range("A1").Cut .Offset(-9, 14)
.Offset(9, -13).Range("A1").Cut .Offset(-8, 13)
.Offset(9, -15).Range("A1").Cut .Offset(-10, 15)
.Offset(10, -14).Range("A1").Cut .Offset(-9, 14)
.Offset(10, -15).Range("A1").Cut .Offset(-11, 16)
.Offset(11, -15).Range("A1").Cut .Offset(-10, 15)
.Offset(1).Resize(11).EntireRow.Delete
End With
Set rgFind1 = Cells.FindNext(rgFind1)
Loop While rgFind1.Address <> sStart
End If
End Sub

dpalmer013
12-12-2013, 01:46 PM
I forgot to include the spreadsheet, see attached.

SamT
12-12-2013, 03:58 PM
Good grief! That's horrible.

Here is your cell reference logic in English.

With rgFind1
From rgFind1
Go down 2 >> up 1, right1
Go down 2, left1 >> down 2, right 2
Go down 2, left1 >> up 1, right1
Find returns a single celled Range, so you are always referring to a single cell. Lose the Range("A1") reference. Just that can speed up the loop by (a ceiling of ) 25%.

Next, rewrite:
Set rgFind1 = Cells.Find(What:="Document Number:", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
To
Dim FindInColumn As Range
Set FindInColumn = Workbooks(Whatever).Range("Q:Q") 'Adjust as needed
Set rgFind1 = FindInColumn.Find(What:="Document Number:", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)


There may be a Pattern in that operation, but the Cut cell Rows are not in order, (2,3,4,5,6,7,8,9,10,11,7,8,9,10,7,8,9,10,11.) Even the Column Offsets of each group of Row Offsets is out of order, (Offset down 2: 0,-1,-1,3,-1,-1,-5.) You cut the same address 4 times in row 2, so the Cut order is fixed, at least as it stand now. We can't help with that because we don't know the before and after States of that operation.

There may be a Pattern in the Insert operations, But I am not going to explore it given the lack of Pattern in the Cut Operations.

I suggest that you create a new Worksheet, and starting in A2 going to Z2, you fill that Row with A...Z, one letter per cell. Copy that down to about Row 14.

Name that sheet "Begin State" and copy it to another new sheet, "End State." Then run the Cut process one time on the "End State" sheet. Upload those sheets here so we can see the Pattern.

If we can analyze a Pattern, we may be able to really speed up your Macro.