0

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
7
  • 6
    Pretty sure this is the first time I've ever seen anything associated with VBA accused of being "too fast". Commented Apr 16, 2018 at 19:24
  • I've had this happen before and I added a line before the part it was skipping to select a cell on the page and that fixed it. Wish I had a better explanation why and I hope that helps you. If it doesn't then make sure that the color index is correct by actually using vba to print what the color index is of the cell you want to delete. Commented Apr 16, 2018 at 19:31
  • I've never seen this happen with code which is "correct" and doesn't deal with some kind of automation. Likely your code is not doing what you think it is. Commented Apr 16, 2018 at 19:49
  • 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 Commented Apr 16, 2018 at 19:52
  • 1
    Code sometimes works when stepping through 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. Commented Apr 16, 2018 at 19:55

2 Answers 2

3

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.

Sign up to request clarification or add additional context in comments.

Comments

0

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.

1 Comment

This made no difference. Tim Williams' answer in the above comment fixed it.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.