Find slowing down

**dingdongsilver** · 05-24-2012, 08:28 AM

When I first open excel and run my sub everything works fine. The sub looks at a value on one sheet, finds it in another sheet, copies that row and pastes it into another sheet. On first run it is extremely fast. I can run them back to back as many times as I want and it works perfectly. However, if I run it and then wait half an hour to run it again it drags. Instead of finding 20 per second it might find one.

Has anyone else experienced anything like this? It seems like a memory leak but I can't comprehend how VBA would be cause that. Thanks for any help.

Sub LinearAlgebraicPokemonComparison()
	
	Dim intForchecks As Integer
	Dim todayDate As Date
	Dim PokedexDate As Date
	myDate = Date
	
	Application.ScreenUpdating = True 'I need to see it work
	With Sheets("Poke Notes")
		
		.Range("A:XFD").Clear
		Sheets("Pokedex").Range("A1:AZ1").Copy Destination:=.Range("A1")
		With .Range("A1:XFD1")
			.Interior.Color = RGB(0, 0, 0)
			With .Font
				.Color = RGB(240, 140, 240)
				.Size = 14
				.Bold = True
			End With
		End With
		
		.Range("B1").EntireColumn.Insert
		
		For i = 3 To Sheets("Squirtle").Cells(Rows.Count, "G").End(xlUp).Row
			
			If Sheets("Squirtle").Range("J" & i).Value <> "Jhoto League" And _
			Sheets("Squirtle").Range("J" & i).Value <> "Professor Oak" Then
			
			Set vFound = Sheets("Pokedex").Columns("L:L").Cells.Find(What:=Sheets("Squirtle").Range("G" & i).Value, _
			MatchCase:=False, LookAt:=xlWhole)
			
			If Not vFound Is Nothing Then
				vStart = vFound.Address
				vMatch = True
				
				Do
					intForchecks = .Range("A" & .Cells(Rows.Count, "B").End(xlUp).Row).Row + 1
					
					Sheets("Pokedex").Range("A" & vFound.Row & ":" & "AM" & vFound.Row).Copy Destination:= _
					.Range("B" & .Cells(Rows.Count, "B").End(xlUp).Row + 1 _
					& ":" & "M" & .Cells(Rows.Count, "B").End(xlUp).Row + 1)
					Set vFound = Sheets("Pokedex").Columns("L:L").Cells.FindNext(vFound)
					
					
					If UCase(.Range("K" & intForchecks).Value) <> UCase(Sheets("Squirtle").Range("I" & i).Value) Then
						.Range("K" & intForchecks).Interior.Color = RGB(255, 0, 0)
					End If
					
					
					If UCase(.Range("E" & intForchecks).Value) <> UCase(Sheets("Squirtle").Range("B" & i).Value) Then
						.Range("I" & intForchecks).Interior.Color = RGB(255, 0, 0)
					End If
					
					
					If UCase(.Range("I" & intForchecks).Value) <> UCase(Sheets("Squirtle").Range("H" & i).Value) Then
						.Range("I" & intForchecks).Interior.Color = RGB(255, 0, 0)
					End If
					
					Set vFound2 = Sheets("Captured Squirtle").Columns("I:I").Cells.Find(What:=.Range("K" & intForchecks).Value, _
					MatchCase:=False, LookAt:=xlWhole)
					If Not vFound2 Is Nothing Then
						vstart2 = vFound2.Address
						numberOfTimesFound = 0
						Do
							numberOfTimesFound = numberOfTimesFound + 1
							.Activate
							.Range("A" & intForchecks).Select
							If numberOfTimesFound <= 1 Then
								.Range("A" & intForchecks).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Captured Squirtle'!I" & vFound2.Row, _
								TextToDisplay:="This pokemon garnered " & Sheets("Captured Squirtle").Range("U" & vFound2.Row).Value
							Else
								.Range("A" & intForchecks).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Captured Squirtle'!I" & vFound2.Row, _
								TextToDisplay:="Bang bang bang " & Sheets("Captured Squirtle").Range("U" & vFound2.Row).Value
							End If
							.Range("A" & intForchecks).Interior.Color = RGB(255, 255, 0)
							numberOfTimesFound = numberOfTimesFound + 1
							Set vFound2 = Sheets("Captured Squirtle").Columns("I:I").Cells.FindNext(vFound2)
						Loop Until vFound2.Address = vstart2
					End If
					
					Set vFound2 = Sheets("Captured Squirtle").Columns("R:R").Cells.Find(What:=.Range("K" & intForchecks).Value, _
					MatchCase:=False, LookAt:=xlWhole)
					If Not vFound2 Is Nothing Then
						vstart2 = vFound2.Address
						numberOfTimesFound = 0
						Do
							numberOfTimesFound = numberOfTimesFound + 1
							.Activate
							.Range("B" & intForchecks).Select
							If numberOfTimesFound <= 1 Then
								.Range("B" & intForchecks).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Captured Squirtle'!I" & vFound2.Row, _
								TextToDisplay:="Down east is the hokey pokey " & Sheets("Captured Squirtle").Range("U" & vFound2.Row).Value
							Else
								.Range("B" & intForchecks).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Captured Squirtle'!I" & vFound2.Row, _
								TextToDisplay:="In a van, down by the river " & Sheets("Captured Squirtle").Range("U" & vFound2.Row).Value
							End If
							.Range("B" & intForchecks).Interior.Color = RGB(255, 255, 0)
							numberOfTimesFound = numberOfTimesFound + 1
							Set vFound2 = Sheets("Captured Squirtle").Columns("R:R").Cells.FindNext(vFound2)
						Loop Until vFound2.Address = vstart2
					End If
					
					Set vFound2 = Sheets("Crazy Squirtle").Columns("I:I").Cells.Find(What:=.Range("K" & intForchecks).Value, _
					MatchCase:=False, LookAt:=xlWhole)
					If Not vFound2 Is Nothing Then
						vstart2 = vFound2.Address
						numberOfTimesFound = 0
						Do
							numberOfTimesFound = numberOfTimesFound + 1
							.Activate
							.Range("C" & intForchecks).Select
							If numberOfTimesFound <= 1 Then
								.Range("C" & intForchecks).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Crazy Squirtle'!I" & vFound2.Row, _
								TextToDisplay:="Charizard " & Sheets("Crazy Squirtle").Range("U" & vFound2.Row).Value
							Else
								.Range("C" & intForchecks).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Crazy Squirtle'!I" & vFound2.Row, _
								TextToDisplay:="Crazy Squirtle " & Sheets("Crazy Squirtle").Range("U" & vFound2.Row).Value
							End If
							.Range("C" & intForchecks).Interior.Color = RGB(255, 255, 0)
							numberOfTimesFound = numberOfTimesFound + 1
							Set vFound2 = Sheets("Crazy Squirtle").Columns("I:I").Cells.FindNext(vFound2)
						Loop Until vFound2.Address = vstart2
					End If
					
					Set vFound2 = Sheets("Crazy Squirtle").Columns("R:R").Cells.Find(What:=.Range("K" & intForchecks).Value, _
					MatchCase:=False, LookAt:=xlWhole)
					If Not vFound2 Is Nothing Then
						vstart2 = vFound2.Address
						numberOfTimesFound = 0
						Do
							numberOfTimesFound = numberOfTimesFound + 1
							.Activate
							.Range("D" & intForchecks).Select
							If numberOfTimesFound <= 1 Then
								.Range("D" & intForchecks).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Crazy Squirtle'!I" & vFound2.Row, _
								TextToDisplay:="Charizard " & Sheets("Crazy Squirtle").Range("U" & vFound2.Row).Value
							Else
								.Range("D" & intForchecks).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Crazy Squirtle'!I" & vFound2.Row, _
								TextToDisplay:="Crazy Squirtle " & Sheets("Crazy Squirtle").Range("U" & vFound2.Row).Value
							End If
							.Range("D" & intForchecks).Interior.Color = RGB(255, 255, 0)
							numberOfTimesFound = numberOfTimesFound + 1
							Set vFound2 = Sheets("Crazy Squirtle").Columns("R:R").Cells.FindNext(vFound2)
						Loop Until vFound2.Address = vstart2
					End If
				Loop Until vFound.Address = vStart
			Else
				intForchecks2 = .Range("A" & .Cells(Rows.Count, "B").End(xlUp).Row).Row + 1
				Set vFound3 = Sheets("Pokedex").Columns("H:H").Cells.Find(What:=Sheets("Squirtle").Range("H" & i).Value, _
				MatchCase:=False, LookAt:=xlWhole)
				If Not vFound3 Is Nothing Then
					vstart3 = vFound3.Address
					Do
						.Activate
						Sheets("Pokedex").Range("A" & vFound3.Row & ":" & "AM" & vFound3.Row).Copy Destination:= _
						.Range("B" & .Cells(Rows.Count, "B").End(xlUp).Row + 1 _
						& ":" & "M" & .Cells(Rows.Count, "B").End(xlUp).Row + 1)
						Sheets("Poke Notes").Range("A" & intForchecks2).EntireRow.Interior.Color = RGB(55, 132, 199)
						Sheets("Poke Notes").Range("A" & intForchecks2).Select
						Sheets("Poke Notes").Range("A" & intForchecks2).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Pokedex'!H" & vFound3.Row, _
						TextToDisplay:="Pokedex has a different pokemon " & Sheets("Pokedex").Range("U" & vFound3.Row).Value
						.Range("A" & intForchecks2).Interior.Color = RGB(255, 132, 199)
						Sheets("Squirtle").Range("Q" & intForchecks2 + 1).Value = "Pokedex has a different pokemon for this grass."
						Set vFound3 = Sheets("Pokedex").Columns("H:H").Cells.FindNext(vFound3)
					Loop Until vFound3.Address = vstart3
				Else
					.Range("A" & ((.Range("B1048576").End(xlUp).Row) + 1)).Value = Sheets("Squirtle").Range("I" & i).Value & " " & _
					Sheets("Squirtle").Range("G" & i).Value & " isn't in the Pokedex"
					.Range("B" & ((.Range("B1048576").End(xlUp).Row) + 1)).Value = "It's really not..."
					.Range("A" & (.Range("A1048576").End(xlUp).Row)).EntireRow.Interior.Color = RGB(255, 0, 0)
					.Range("A" & (.Range("A1048576").End(xlUp).Row)).Font.Size = 15
				End If
				
			End If
		End If
		Next i
		
		If vMatch <> True Then
			MsgBox ("NO MATCHES FOUND")
		End If
		
		.Cells.EntireColumn.AutoFit
		
	End With
End Sub

**111StepsAhead** · 05-24-2012, 08:45 AM

Why do you need to "see" it work?

**dingdongsilver** · 05-24-2012, 10:17 AM

Originally Posted by 111StepsAhead

Why do you need to "see" it work?

Yeah, I guess that would help :S I'll have to format the sheet to work without the rest of the code. I'll post it as soon as I can.

**111StepsAhead** · 05-24-2012, 11:19 AM

I'm not sure if you understand what that line is doing.

Application.ScreenUpdating = True/False

simply waits until the macro is done running before updating everything when False. If True you are updating the screen after each step which takes significantly more time. It doesn't fully explain why the macro is slowing down after 20 minutes of opening but the difference in speed that you will see should still be a lot.

**dingdongsilver** · 05-24-2012, 01:40 PM

Originally Posted by 111StepsAhead

I'm not sure if you understand what that line is doing.

Application.ScreenUpdating = True/False

simply waits until the macro is done running before updating everything when False. If True you are updating the screen after each step which takes significantly more time. It doesn't fully explain why the macro is slowing down after 20 minutes of opening but the difference in speed that you will see should still be a lot.

Yeah, I have that on because when ScreenUpdating is off I can't see how fast the script is running. So if it is doing it's going super slow thing I can't tell.