Excel Vba Code Continues to Be Interupted After F5

Hello,

I'm trying to solve a problem with my code. It will be hard to replicate as the code I'm posting is a sub that is called from another routine, but I'm hoping there is enough description here for someone to point me at possible causes. Another post has a similar problem, and by the looks of that, my poor programming skills are to blame, but beyond that, I'm lost. The post is here:

http://www.excelforum.com/exce…ut-not-at-full-speed.html

In short the code searches through each cell of a sheet, and if it finds a cell of a certain colour (determined by the users' selection in a different routine), then it will add a named range to that cell. After much head scratching, I've determined that the code stops working at this IF statement (before the named range is added):

                                                                                    If Cell.Interior.ColorIndex = DBcolorIndex Then

And further more, if I step through the code whilst debugging, the line below produces a different result than if I run the code normally; the result for a yellow cell is '6' if I'm debugging, and '-2' if I run normally.

Thanks for reading so far. I'm In and out of meetings, so I might not be able to respond straight away. The full routine is here:

                                                                                    Sub test()                                                                                                                    Dim rangeSheet As Worksheet                                                                                                                    Dim stlocation As String                                                                                                                    Set rangeSheet = Sheets("sheet1")                                                                                                                    stlocation = "'Sheet1'!$A$1"                                                                                                                    Call AddFields(rangeSheet, stlocation)                                                                                                                    End Sub                                                                                                                                                                                                                                                                                                                                                            Sub AddFields(rangeSheet As Worksheet, stlocation As String)                                                                                                                    'Debug.Print stlocation                                                                                                                                                                                                                                        Application.ScreenUpdating = False                                                                                                                                                    Set wsf = Application.WorksheetFunction                                                                                                                                                    Dim test As Integer                                                                                                                                                    Dim thissheet As Worksheet                                                                                                                                                    Dim lastRow As Long                                                                                                                                                    Dim lastcolumn As Long                                                                                                                                                    Dim DBcolorIndex As Double                                                                                                                                                                                                                                                                        Dim rgArea As Range                                                                                                                                                    Dim rgField As Range                                                                                                                                                                                                                                                                        Dim BaseFieldCode As String                                                                                                                                                    Dim fieldname As String                                                                                                                                                    Dim fieldType As String                                                                                                                                                    Dim activeCellRow As Double                                                                                                                                                    Dim stValidation As String                                                                                                                                                    Dim stCellAddress As String                                                                                                                                                    Dim stQuestion As String                                                                                                                                                    Dim stQuestionNumber As String                                                                                                                                                    Dim stQuestionWording As String                                                                                                                                                    Dim stRecord As String                                                                                                                                                    Dim stSheet As String                                                                                                                                                                                                                                                                        Set rgField = Range(stlocation)                                                                                                                                                                                                                                                                        'Set ThisSheet = ActiveSheet                                                                                                                                                    Set thissheet = rangeSheet                                                                                                                                                                                                                                                                        BaseFieldCode = sheetCode(thissheet)                                                                                                                                                                                                                                                                        DBcolorIndex = rgField.Interior.ColorIndex                                                                                                                                                    activeCellRow = rgField.Row                                                                                                                                                                                                                                                                        lastRow = FindLastCell(1, thissheet)                                                                                                                                                    lastcolumn = FindLastCell(2, thissheet)                                                                                                                                                    Select Case activeCellRow                                                                                                                                                    Case Is < 0                                                                                                                                                    'if field is on first row, then use the user defined field name (no longer used)                                                                                                                                                    Range(Cells(1, 1), Cells(1, lastcolumn)).Select                                                                                                                                                    Call AddRangeBasedOnSelection                                                                                                                                                                                                                                                                                                                                                                                            Case Is > 0                                                                                                                                                    With thissheet                                                                                                                                                    'Debug.Print .Name                                                                                                                                                                                                                                                                        .Activate                                                                                                                                                                                                                                                                        Set rgArea = .Range(.Cells(1, 1), .Cells(lastRow, lastcolumn))                                                                                                                                                                                                                                                                        End With                                                                                                                                                                                                                                                                        For Each Cell In rgArea                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                stCellAddress = Evaluate("ADDRESS(" & Cell.Row & "," & Cell.Column & ",1,1,""" & Cell.Worksheet.Name & """)")                                                                                                                                                    stSheet = Cell.Worksheet.Name                                                                                                                                                    stcolumn = Cell.Column                                                                                                                                                    strow = Cell.Row                                                                                                                                                    stValidation = ""                                                                                                                                                                                                                                                                                                                                                                                            '**********************************************************************************                                                                                                                                                    'Checking Variable Values                                                                                                                                                    '**********************************************************************************                                                                                                                                                    test = 0                                                                                                                                                    test = test + 1                                                                                                                                                    If test < 100 Then                                                                                                                                                    Debug.Print Cell.Address & ":" & Cell.Interior.ColorIndex & "|" & DBcolorIndex                                                                                                                                                    End If                                                                                                                                                                                                                                                                        '**********************************************************************************                                                                                                                                                    'Cell $E$12 is yellow, and should return value 6                                                                                                                                                    '                                                                                                                                                    'Result when running                                                                                                                                                    '$E$12:-2|6                                                                                                                                                    '                                                                                                                                                    'Result when step into                                                                                                                                                    '$E$12:6|6                                                                                                                                                    '**********************************************************************************                                                                                                                                                                                                                                                                                                                                                                                            '**********************************************************************************                                                                                                                                                    'IF Statement doesn't work when running (F5) but does work when Stepping into (F8)                                                                                                                                                    '**********************************************************************************                                                                                                                                                                                                                                                                        If Cell.Interior.ColorIndex = DBcolorIndex Then                                                                                                                                                                                                                                                                        If Cell.Value = 0 And Cell.Value <> "" Then                                                                                                                                                    fieldType = "FN_"                                                                                                                                                    Else                                                                                                                                                    fieldType = "FC_"                                                                                                                                                    If Cell.Value <> "" Then                                                                                                                                                    stValidation = Cell.Value                                                                                                                                                    stValidation = Replace(stValidation, " ", "", 1)                                                                                                                                                    stValidation = Replace(stValidation, ";", ",", 1)                                                                                                                                                    End If                                                                                                                                                    End If                                                                                                                    x1 = 0                                                                                                                                                    Do                                                                                                                                                    fieldname = fieldType & BaseFieldCode & x1 & "_" & Cell.Address                                                                                                                                                    fieldname = Replace(fieldname, "$", "", 1)                                                                                                                                                    fieldExist = nameExists(fieldname)                                                                                                                                                    x1 = x1 + 1                                                                                                                                                    Loop Until fieldExist = False                                                                                                                                                                                                                                                                        'add field name                                                                                                                                                    'Debug.Print fieldname                                                                                                                                                    Range(stCellAddress).Activate                                                                                                                                                                                                                                                                        ActiveWorkbook.Names.Add Name:=fieldname, RefersTo:="=" & stCellAddress                                                                                                                                                                                                                                                                        Dim rgValidation As Range                                                                                                                                                    If Cell.Row > 1 Then                                                                                                                                                    Set rgValidation = Range(fieldname)                                                                                                                                                    Else                                                                                                                                                    With Sheets(stSheet)                                                                                                                                                    Set rgValidation = .Range(.Cells(12, Cell.Column), .Cells(111, Cell.Column))                                                                                                                                                    End With                                                                                                                                                                                                                                                                        End If                                                                                                                                                    With rgValidation.Validation                                                                                                                                                    .Delete                                                                                                                                                    'rgValidation.Select                                                                                                                                                                                                                                                                        If stValidation <> "" Then                                                                                                                                                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertWarning, Operator:= _                                                                                                                                                    xlBetween, Formula1:=stValidation                                                                                                                                                    .IgnoreBlank = True                                                                                                                                                    .InCellDropdown = True                                                                                                                                                    .InputTitle = ""                                                                                                                                                    .ErrorTitle = ""                                                                                                                                                    .InputMessage = "Please choose one of the following from the drop down box: " & stValidation                                                                                                                                                    .ErrorMessage = "Please choose one of the following from the drop down box: " & stValidation                                                                                                                                                    .ShowInput = False                                                                                                                                                    .ShowError = True                                                                                                                                                    End If                                                                                                                                                    End With                                                                                                                                                                                                                                                                        If activeCellRow > 1 Then                                                                                                                                                    stQuestion = getwords(fieldname, ActiveWorkbook)                                                                                                                                                    stQuestionWording = Mid(stQuestion, wsf.Find("-", stQuestion, 1) + 1, 1000)                                                                                                                                                    stQuestionNumber = Left(stQuestion, wsf.Find("-", stQuestion, 1) - 1)                                                                                                                                                    Else                                                                                                                                                    stQuestion = ""                                                                                                                                                    stQuestionNumber = Cells(8, Cell.Column)                                                                                                                                                    stQuestionWording = Cells(9, Cell.Column)                                                                                                                                                                                                                                                                        End If                                                                                                                                                    'stSheet = cell.Parent                                                                                                                                                    stRecord = ( _                                                                                                                                                    fieldname & "|" _                                                                                                                                                    & "'=" & stCellAddress & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & stValidation & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & "'" & stSheet & "|" _                                                                                                                                                    & stcolumn & "|" _                                                                                                                                                    & strow & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & stQuestionNumber & "|" _                                                                                                                                                    & stQuestionWording & "|" _                                                                                                                                                    & "|" _                                                                                                                                                    & "|")                                                                                                                                                                                                                                                                        'Debug.Print IsEmpty(vrRangesSheet)                                                                                                                                                    vrRangesSheet = addRecordToRangesSheet(vrRangesSheet, stRecord)                                                                                                                                                                                                                                                                                                                                                                                            End If                                                                                                                                                    Next                                                                                                                                                    End Select                                                                                                                    Application.ScreenUpdating = True                                                                                                                    End Sub                                                                                                                                                                                                                                                                                                                                                            Function sheetCode(wssheet As Worksheet)                                                                                                                                                    Dim stName As String                                                                                                                                                    Dim x As Integer                                                                                                                                                    Dim i As Integer                                                                                                                                                    Dim thisChar As String                                                                                                                                                    Dim newName As String                                                                                                                                                    Dim validcars As String                                                                                                                                                                                                                                                                        validchars = "1234567890abcdefghijklmonopqrstuvwxyz"                                                                                                                                                    stName = wssheet.Name                                                                                                                                                    newName = Left(stName, 1)                                                                                                                                                    For x = 2 To Len(stName)                                                                                                                                                                                                                                                                        thisChar = Mid(stName, x, 1)                                                                                                                                                                                                                                                                        On Error Resume Next                                                                                                                                                    i = 0                                                                                                                                                    i = WorksheetFunction.Find(LCase(thisChar), validchars)                                                                                                                                                    lastchar = UCase(Mid(stName, x - 1, 1))                                                                                                                                                    If i > 0 Then                                                                                                                                                    On Error GoTo 0                                                                                                                                                                                                                                                                        If thisChar = UCase(Mid(stName, x, 1)) Then                                                                                                                                                    newName = newName & thisChar                                                                                                                                                    ElseIf lastchar = " " Then                                                                                                                                                    newName = newName & UCase(thisChar)                                                                                                                                                    End If                                                                                                                                                                                                                                                                        End If                                                                                                                                                    Next x                                                                                                                                                    newName = newName & "." & wssheet.Index                                                                                                                                                    sheetCode = newName                                                                                                                    End Function                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    Function FindLastCell(Choice As Long, wssheet As Worksheet)                                                                                                                    '1 last row                                                                                                                    '2 last column                                                                                                                    Dim lastcolumn As Long                                                                                                                    Dim lastRow As Long                                                                                                                                                    Select Case Choice                                                                                                                                                    Case 1                                                                                                                                                    With wssheet                                                                                                                                                    lastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row                                                                                                                                                    End With                                                                                                                                                    FindLastCell = lastRow                                                                                                                                                    Case 2                                                                                                                                                    With wssheet                                                                                                                                                    lastcolumn = .Range("A1").SpecialCells(xlCellTypeLastCell).Column                                                                                                                                                    End With                                                                                                                                                    FindLastCell = lastcolumn                                                                                                                                                    End Select                                                                                                                    End Function

Display More

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

How are you stepping through it at all as your sub takes arguments?

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

I add a break point at the top of the routine

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

OK - so the code seems to work if call it from a different sub, so the problem is probably further back in my code. That might be harder to look through as the original call comes from a form. Any ideas on what sorts of things I should look for?

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

You need to check you're using the same arguments when stepping through.

And do you have more than one workbook in play?

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

Quote from kev22;700213

OK - so the code seems to work if call it from a different sub, so the problem is probably further back in my code. That might be harder to look through as the original call comes from a form. Any ideas on what sorts of things I should look for?

I've modified the code in my first post so that if you take a new sheet in excel, and colour cell A1 yellow, and run the code on that it should run fine (it seems to work, both running and stepping through.

However, when I run the program from my userform using this code, I get the problem described above, where it will only run if I stop the code in the middle of running and step through it.

                                                                                    Private Sub CommandButton1_Click()                                                                                                                    'Application.ScreenUpdating = False                                                                                                                    Debug.Print "CommandButton1_Click()"                                                                                                                    Dim stlocation As String                                                                                                                    If fm_SelectaCell.RefEdit1.Value <> "" Then                                                                                                                                                    stlocation = fm_SelectaCell.RefEdit1.Value                                                                                                                                                                                                                                                                        Debug.Print ActiveSheet.Name                                                                                                                                                    Call AddFields(ActiveSheet, stlocation)                                                                                                                                                    Unload fm_SelectaCell                                                                                                                    Else                                                                                                                                                    MsgBox ("field not selected, click the reference box to choose a field")                                                                                                                    End If                                                                                                                    'Application.ScreenUpdating = True                                                                                                                    End Sub

Display More

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

Quote from StephenR;700220

You need to check you're using the same arguments when stepping through.

And do you have more than one workbook in play?

I have two workbooks in play - one that the user wants to add named ranges to, and one that holds the user form and calls the routine. I'm using the same arguments (if I've understood you correctly) - Literally, if I interupt the code using a breakpoint or watch then it works, if I leave it to run by itself, then it doesn't.

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

You don't have any workbook references so if workbook 1 is active when you step through but workbook 2 is active when running normally you will get different results.

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

Quote from StephenR;700233

You don't have any workbook references so if workbook 1 is active when you step through but workbook 2 is active when running normally you will get different results.

Nice one, that's the bit I was missing. Thanks Stephen!

For interest, I updated the code as follows:
Caller:

                                                                                    Call AddFields(ActiveWorkbook, ActiveSheet, stlocation)

Main Program

                                                                                    Sub AddFields(rangeBook As Workbook, rangeSheet As Worksheet, stlocation As String)                                                                                                                    'Debug.Print stlocation                                                                                                                                                    rangeBook.Activate

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

Good news.

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

Quote from StephenR;700242

Good news.

Hi Again. Actually, I spoke to soon. When I run again today, I find that my modification doesn't work. Is there a better way to reference the workbook, or see if there is indeed something else going on here. I'm not convinced now that it is just a simple issue like the sheet being active, as when I step through, I'm only clicking in the VB window, I'm not manually activating windows to 'take a peek' of whats happening. Seems strange to me - stepping through works fine, running straight through doesn't.

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

You could reference everything in your calling sub and have only one argument in AddFields. Don't know the detail of your code, but just make sure you always fully reference ranges. If you refer to the workbook and worksheet when you assign to object variables, you don't need to do anything further. If problems persist you'll have to post a sample workbook.

                                                                                    Sub test()                                                                                                                                                                                                                                                                                                                                                            Dim r As Range                                                                                                                                                                                                                                                                                                                                                            Set r = Workbooks("Book1").Sheets("sheet1").Range("A1")                                                                                                                    Call AddFields(r)                                                                                                                                                                                                                                                                                                                                                            End Sub

Display More

Re: F8 (Step in to) produces different results than running (F5) VBA excel code

Quote from StephenR;700394

You could reference everything in your calling sub and have only one argument in AddFields. Don't know the detail of your code, but just make sure you always fully reference ranges. If you refer to the workbook and worksheet when you assign to object variables, you don't need to do anything further. If problems persist you'll have to post a sample workbook.

                                                                                                Sub test()                                                                                                                                                                                                                                                                                                                                                                                                            Dim r As Range                                                                                                                                                                                                                                                                                                                                                                                                            Set r = Workbooks("Book1").Sheets("sheet1").Range("A1")                                                                                                                                    Call AddFields(r)                                                                                                                                                                                                                                                                                                                                                                                                            End Sub

Display More

OK I'll give it that a try (much tidier than my code too!), though I think there might be more to this than just the code I've posted here. It seems that the program works better on some workbooks that others. My test workbooks happened to be bad cases, though I'm not clear what they have in common, so I'll explore that next. I think we've taken this as far as we can for now. Thanks for your time all the same, I progressed a lot further and faster for your help, and I've discovered a workaround for now too. Cheers.

Excel Vba Code Continues to Be Interupted After F5

F8 (Step in to) produces different results than running (F5) VBA excel code

0 Response to "Excel Vba Code Continues to Be Interupted After F5"

Post a Comment

Iklan Atas Artikel

Iklan Tengah Artikel 1

Iklan Tengah Artikel 2

Iklan Bawah Artikel