A
airwot4
I've written the following code to compare one list to a second, if
the entry in list 1 does not exist in list 2 it is deleted from list
1.
The results are not correct when it is run, some are deleted that
should be and some are missed. I am relatively sure this code is
correct, when I step through it seems to run correctly. Only when the
script is run it seems to miss things.
Is a memory leak causing this problem?
--
Sub Extract()
Dim i As Integer
Dim wbSummary As Worksheet
Dim wbCurrent As Worksheet
Dim number As Integer
Dim surname As String
Dim r As Integer
Dim d As Boolean
Set wbSummary = Worksheets("Summary")
Application.ScreenUpdating = False
i = 4
For i = 4 To 2479
number = wbSummary.Cells(i, 4)
surname = UCase(wbSummary.Cells(i, 2))
Select Case wbSummary.Cells(i, 5)
Case Is = "A"
Set wbCurrent = Worksheets("TT")
Case Is = "B"
Set wbCurrent = Worksheets("TT")
Case Is = "C"
Set wbCurrent = Worksheets("DD")
Case Is = "D"
Set wbCurrent = Worksheets("DD")
Case Is = "E"
Set wbCurrent = Worksheets("AA")
Case Is = "F"
Set wbCurrent = Worksheets("AA")
End Select
r = 4
For r = 4 To 3441
If wbCurrent.Cells(r, 6).Value = number Then
If UCase(wbCurrent.Cells(r, 4)) = surname Then
d = True
Exit For
Else
d = False
End If
Else
d = False
End If
Next
If d = False Then
wbSummary.Rows(i).Delete
Else
End If
Next
End Sub
the entry in list 1 does not exist in list 2 it is deleted from list
1.
The results are not correct when it is run, some are deleted that
should be and some are missed. I am relatively sure this code is
correct, when I step through it seems to run correctly. Only when the
script is run it seems to miss things.
Is a memory leak causing this problem?
--
Sub Extract()
Dim i As Integer
Dim wbSummary As Worksheet
Dim wbCurrent As Worksheet
Dim number As Integer
Dim surname As String
Dim r As Integer
Dim d As Boolean
Set wbSummary = Worksheets("Summary")
Application.ScreenUpdating = False
i = 4
For i = 4 To 2479
number = wbSummary.Cells(i, 4)
surname = UCase(wbSummary.Cells(i, 2))
Select Case wbSummary.Cells(i, 5)
Case Is = "A"
Set wbCurrent = Worksheets("TT")
Case Is = "B"
Set wbCurrent = Worksheets("TT")
Case Is = "C"
Set wbCurrent = Worksheets("DD")
Case Is = "D"
Set wbCurrent = Worksheets("DD")
Case Is = "E"
Set wbCurrent = Worksheets("AA")
Case Is = "F"
Set wbCurrent = Worksheets("AA")
End Select
r = 4
For r = 4 To 3441
If wbCurrent.Cells(r, 6).Value = number Then
If UCase(wbCurrent.Cells(r, 4)) = surname Then
d = True
Exit For
Else
d = False
End If
Else
d = False
End If
Next
If d = False Then
wbSummary.Rows(i).Delete
Else
End If
Next
End Sub