CODEWITHSUNDEEP
vbaexcel
Dave
Dave

Reputation: 13

Excel VBA For loop running too fast? Skipping delete row

Tried searching but nothing seems to specifically answer what I'm after..

For some reason it seems the code is running too fast and skipping the code within the IF section.

So far I've tried adding Application.Wait, creating a separate sub with the IF'd code to be called out in an effort to slow it down. Nothing has proved successful.

The basic purpose is to import a sheet, copy it to the active workbook, then delete rows which are red and finish by deleting the imported sheets.

Everything works except the red rows remain on the target sheet.

Stepping through the process with F8 yields a successful result!

Sub Grab_Data()
'FOR THE DEBUG TIMER
Dim StartTime As Double
Dim MinutesElapsed As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False

Dim targetWorkbook As Workbook

'Assume active workbook as the destination workbook
Set targetWorkbook = Application.ActiveWorkbook

'Import the Metadata
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xlsm; *.xlsx", Title:="Open 
Workbook")
If sImportFile = "False" Then
MsgBox "No File Selected!"
Exit Sub

Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile

StartTime = Timer

Set wbBk = Workbooks(sFile)
With wbBk


'COPY TV SHOWS SHEET
If SheetExists("TV") Then
Set wsSht = .Sheets("TV")
wsSht.Copy after:=sThisBk.Sheets(Sheets.Count)
ActiveSheet.Name = "TV 2"
Else
MsgBox "There is no sheet with name :TV in:" & vbCr & .Name
End If


wbBk.Close SaveChanges:=False
End With
End If


Set wsSht = Nothing
Set sThisBk = Nothing

'#########TV##########
'Set sheets to TV
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets("TV")
Dim sourceSheet As Worksheet
Set sourceSheet = targetWorkbook.Worksheets("TV 2")


'Find Last Rows
Dim LastRow As Long
With sourceSheet
    LastRow = .Cells(rows.Count, "A").End(xlUp).Row
End With

Dim LastRow2 As Long
With targetSheet
    LastRow2 = .Cells(rows.Count, "C").End(xlUp).Row
End With

'Remove RED expired rows
With sourceSheet

For iCntr = LastRow To 1 Step -1

If Cells(iCntr, 2).Interior.ColorIndex = 3 Then

    rows(iCntr).EntireRow.Delete

    Debug.Print iCntr
End If

Next


End With

'Variables for TV

targetSheet.Range("B4:B" & LastRow).Value = sourceSheet.Range("E2:E" & 
LastRow).Value
sourceSheet.Range("E2:E" & LastRow).Copy
targetSheet.Range("B4:B" & LastRow).PasteSpecial xlFormats


Set targetSheet = Nothing
Set sourceSheet = Nothing

'Delete imported sheets
With ActiveWorkbook
.Sheets("TV 2").Delete
.Sheets("Movies 2").Delete
.Sheets("Audio 2").Delete
End With

LastRow = Sheets("TV").Cells(rows.Count, "B").End(xlUp).Row


End With

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", 
vbInformation



End Sub


Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function

Upvotes: 0

Views: 1487

Answers (2)

Tim Williams
Tim Williams

Reputation: 166241

You have With sourceSheet but inside that block none of your range references are scoped to that With. eg 

If Cells(iCntr, 2).Interior.ColorIndex = 3 Then

should be 

If .Cells(iCntr, 2).Interior.ColorIndex = 3 Then

check all your other range references for similar issues.

Code which is not working as expected sometimes works when stepping through: this is often because the activeworkbook at any given point is different from when you run it straight through. That's why every range/sheet reference should be fully qualified to remove any ambiguity.

Upvotes: 3

matt2103
matt2103

Reputation: 321

Application.Calculation = xlManual is your problem--functions and formatting aren't updating, so your if statement isn't firing properly.

Add Application.CalculateFull before the problem lines, and it should work.

Upvotes: 0

Related Questions