Running VBA Code

[ChewDoggie]

Hello all,

I've written some VBA code in a 'Worksheet_Change' Event. But the code doesn't execute on the Employee's PC.

Does anything need to be installed on the PC to make the code run ?

FYI...the Macros are enabled and the Employee has proper permissions on the file.

Thanks !

Chew


10% of your life is what happens to you. 90% of your life is how you deal with it.

 

[SkipVought]

Hi,

Put a BREAK on the first execuatble statement of the code.

Make a change on the sheet.

Observe if the break occurs.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

Out of curiosity, do you have any Application.EnableEvents = FALSE in your code?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[ChewDoggie]

Sorry, Skip....meetings and whatnot keeping me from having fun.

I do not have Application.EnableEvents = FALSE in my code. prior to posting my question, I placed a breakpoint in my code and made a change to the form and the breakpoint wasn't hit.

I just checked file permissions and she didn't have write access. Don't know if that affects outcome but will report back this afternoon.

Chew


10% of your life is what happens to you. 90% of your life is how you deal with it.

 

[SkipVought]

AFAIK, file permissions would not be an issue.

So this is a workbook that you produced, containing event code. Your co-worker opens a copy of this workbook, enabling macros and nothing happens when a cell value changes on that particular worksheet.

BTW, a formula value changing does not trigger a worksheet_change event.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[PHV]

To be sure, try a Calculate event procedure.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[ChewDoggie]

BTW, a formula value changing does not trigger a worksheet_change event.

Interesting as I find that exactly the opposite is true. When I step through my code and hit this line of code:

Range("I" & SelectedRow).Formula = "=IF(H" & SelectedRow & "=0,"""",IF(H" & SelectedRow & "<=2,0.25,IF(H" & SelectedRow & "<=4,0.5,IF(H" & SelectedRow & "<=6,0.75,IF(H" & SelectedRow & "<=7.99,1,IF(H" & SelectedRow & ">=8,H" & SelectedRow & "/8*1,""""))))))"

It triggers the Worksheet_Change Event and I now find myself stepping through the Worksheet_Change Event all over again. That one issue has forced the following code change:

SelfEditing = True
Range("I" & SelectedRow).Formula = "=IF(H" & SelectedRow & "=0,"""",IF(H" & SelectedRow & "<=2,0.25,IF(H" & SelectedRow & "<=4,0.5,IF(H" & SelectedRow & "<=6,0.75,IF(H" & SelectedRow & "<=7.99,1,IF(H" & SelectedRow & ">=8,H" & SelectedRow & "/8*1,""""))))))"
SelfEditing = False

Then I test the SelfEditing flag in the Worksheet_Change Event to loop out early.

In any event, the code designed to executed when the user changes a cell's value, not formula.

I'll investigate further and report back.

Chew


10% of your life is what happens to you. 90% of your life is how you deal with it.

 

[SkipVought]

That's because you are changing the FORMULA and not just calculating a new VALUE.

Notice, I stated, "BTW, a formula value changing does not trigger a worksheet_change event." I did not say that the formula was changing.

In any event, the code designed to executed when the user changes a cell's value, not formula.

Please explain HOW the user changes a cell's value on this sheet.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[ChewDoggie]

or did you mean that when a USER edits a formula, it doesn't trigger the Worksheet_Change Event ?

Sorry, I didn't understand.

Chew

10% of your life is what happens to you. 90% of your life is how you deal with it.

 

[SkipVought]

If the user EDITS a formula, the Worksheet_Change event will fire.

If the user just calculates a new value, then NO worksheet_Change event occurs.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[xlbo]

e.g.

you have sheet A and sheet B

formulae on sheet A reference cells on sheet B

There is a change event on sheet A

When you change a number in sheet B, no change event is fired as no physical change has happened on sheet A

When you go into a cell in sheet A to edit a formula (even if you make no change), excel sees this as data being entered into a cell and fires the change event

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[ChewDoggie]

sorry, this is an issue again.

She once again is saying that when she edits the value in column "M", nothing happens. I went to her workstation and opened the VBA code (by pressing Alt+F11) and placed a breakpoint in the code in the 'Private Sub Worksheet_Change(ByVal Target As Range)' Sub. I entered a value in cell M9 and pressed the enter key on the keyboard.

The breakpoint never gets hit. Let me know if this is an issue:

I developed this in Excel 2003. She's running Excel 2007. Macros are enabled on her side.

Is there something in Excel 07 that'd stop the code from executing.

Thanks !

Chew

10% of your life is what happens to you. 90% of your life is how you deal with it.

 

[SkipVought]

Please post the ENTIRE event code.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[ChewDoggie]

So sorry, I meant to burn it and bring it home, but didn't. I'll have to do it Monday.

C.

10% of your life is what happens to you. 90% of your life is how you deal with it.

 

[ChewDoggie]

Here's my code:

Dim SelfEditing                 As Boolean
Dim ActivatingForm              As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim TopEmpRow       As Integer
    Dim AssociateID     As String
    Dim ThisValue       As String
    Dim MRange          As String
    Dim ThisRow         As Integer
    Dim i               As Integer
    Dim LastRow         As Integer
    
    On Error Resume Next
    If Target.Count > 1 Then
        Exit Sub
    End If
    If Not Intersect(Range("AA1"), Target) Is Nothing Then
        ActivatingForm = False
        If Trim(Range("AA1").Value) = "" Then
            If MsgBox("This Audit MAY take up to 15 minutes AND disable your computer for that period of time" & vbCrLf & vbCrLf & "Do you wish to Continue?", vbYesNo, "Audit Confirmation") = vbNo Then
                SelfEditing = True
                Range("AA1").Value = "DELETE CELL TO AUDIT ATTENDANCE SHEET"
                SelfEditing = False
                Exit Sub
            End If
            ActivatingForm = True
            TopEmpRow = 8
            Application.Cursor = xlWait
            Application.DisplayStatusBar = True
            Do Until UCase(Trim(Range("D" & TopEmpRow).Value)) = "GRAND TOTAL"
                AssociateID = Trim(Range("D" & TopEmpRow).Value)
                ' here we're searching for the LAST ROW of each associate's record
                Do Until Not IsNumeric(AssociateID)
                    AssociateID = Trim(Range("D" & TopEmpRow).Value)
                    TopEmpRow = TopEmpRow + 1
                Loop
                ' now go up TWO rows to the LAST ROW
                TopEmpRow = TopEmpRow - 2
                MRange = "M" & TopEmpRow
                Application.StatusBar = "Auditing Associate ID " & Trim(Range("D" & TopEmpRow).Value) & ", Row # " & TopEmpRow
                ' grab whatever value is in the "M" column
                ThisValue = Trim(Range(MRange).Value)
                SelfEditing = True
                ' place a new character in the "M column.  This triggers code below
                Range(MRange).Value = "*"
                ' set the SelfEditing flag to true so that NO CODE BELOW executes
                SelfEditing = False
                Range(MRange).Value = ThisValue
                ' set the SelfEditing flag to false to re-enable code execution
                ' increment the row counter TWO places to go to the NEXT associate's record
                TopEmpRow = TopEmpRow + 2
            Loop
            Application.DisplayStatusBar = False
            Application.Cursor = xlDefault
            SelfEditing = True
            Range("AA1").Value = "DELETE CELL TO AUDIT ATTENDANCE SHEET"
            SelfEditing = False
            ActivatingForm = False
        End If
    Else
        If Not SelfEditing Then
            If Not Intersect(Range("M" & Target.Row), Target) Is Nothing Then
                If Not ActivatingForm Then
                    Application.Cursor = xlWait
                End If
                TopEmpRow = Target.Row
                Do Until Not IsNumeric(Trim(Range("D" & TopEmpRow)))
                    TopEmpRow = TopEmpRow - 1
                Loop
                TopEmpRow = TopEmpRow + 1
                Call ProcessRows(TopEmpRow)
                If Not ActivatingForm Then
                    Application.Cursor = xlDefault
                End If
            End If
        End If
    End If
End Sub

Private Sub ProcessRows(WhichRow As Integer)
    Dim SelectedStartDate       As Date
    Dim SelectedEndDate         As Date
    Dim EndDateFound            As Boolean
    Dim SelectedRow             As Integer
    Dim DateLoc                 As Integer
    Dim DiffDays                As Integer
    Dim AddDays                 As Integer
    Dim RowNum                  As Integer
    Dim SelectedAssociateID     As String
    Dim ParsedData              As String
    Dim KRange                  As String
    Dim MRange                  As String
    Dim FRange                  As String
    Dim HFormula                As String
    Dim IFormula                As String
    Dim NFormula                As String
    Dim rsOver5Days             As ADODB.Recordset
    Dim rs                      As ADODB.Recordset
    
    On Error Resume Next
    SelectedRow = WhichRow
    SelectedAssociateID = Trim(Range("D" & SelectedRow).Value)
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Fields.Append "RowNum", adInteger, 3, adFldUpdatable
    rs.Fields.Append "StartDate", adDate, , adFldUpdatable
    rs.Fields.Append "EditField", adInteger, , adFldUpdatable
    rs.Open
    Set rsOver5Days = New ADODB.Recordset
    rsOver5Days.CursorLocation = adUseClient
    rsOver5Days.Fields.Append "RowNum", adInteger, 2, adFldUpdatable
    rsOver5Days.Fields.Append "StartDate", adDate, , adFldUpdatable
    rsOver5Days.Fields.Append "EndDate", adDate, , adFldMayBeNull
    rsOver5Days.Fields.Append "DiffDays", adInteger, , adFldUpdatable
    rsOver5Days.Open
    Do Until Not IsNumeric(SelectedAssociateID)
        KRange = "K" & SelectedRow
        MRange = "M" & SelectedRow
        FRange = "F" & SelectedRow
        EndDateFound = False
        SelectedStartDate = CDate(Trim(Range(FRange).Value))
        If IsDate(Trim(Range(MRange).Value)) Then ' if there is a date in the "M" column
            SelectedEndDate = CDate(Trim(Range(MRange).Value)) ' Convert the string to a date
            EndDateFound = True
        Else
            DateLoc = InStr(1, Trim(Range(KRange).Value), "/") ' is there a slash ("/") in the "K" column?
            If DateLoc = 0 Then ' there ISN'T a slash in the "K" column
                DateLoc = InStr(1, Trim(Range(KRange).Value), "-") ' is there a hyphen ("-") in the "K" column?
                If DateLoc > 0 Then ' Thre IS a hypen in the "K" column
                    ParsedData = ParseCommentsForDate(DateLoc, SelectedRow, "-")
                    If IsDate(ParsedData) Then
                        SelectedEndDate = CDate(ParsedData)
                        EndDateFound = True
                    End If
                End If
            Else ' There IS a slash, parse the data to see if it's a Date !
                ParsedData = ParseCommentsForDate(DateLoc, SelectedRow, "/")
                If IsDate(ParsedData) Then ' it IS a Date
                    SelectedEndDate = CDate(ParsedData)
                    EndDateFound = True
                End If
            End If
        End If
        rs.AddNew
        rs!RowNum = SelectedRow
        rs!StartDate = SelectedStartDate
        If Trim(Range("G" & SelectedRow).Value) > 0 Then
            rs!EditField = 1
        Else
            rs!EditField = 0
        End If
        rs.Update
        If EndDateFound Then
            If Not ActivatingForm Then
                If SelectedEndDate < SelectedStartDate Then
                    Call MsgBox("The Thru Date CANNOT BE BEFORE the Date Missed", vbOKOnly, "Invalid Entry")
                    SelfEditing = True
                    Range("M" & SelectedRow).Value = ""
                    Range("M" & SelectedRow).Select
                    SelfEditing = False
                    Exit Sub
                End If
            End If
            DiffDays = DateDiff("d", SelectedStartDate, SelectedEndDate) + 1
            If DiffDays > 5 Then
                rsOver5Days.AddNew
                rsOver5Days!RowNum = SelectedRow
                rsOver5Days!StartDate = SelectedStartDate
                rsOver5Days!EndDate = SelectedEndDate
                rsOver5Days!DiffDays = DiffDays
                rsOver5Days.Update
            End If
        End If
        SelectedRow = SelectedRow + 1
        SelectedAssociateID = Trim(Range("D" & SelectedRow).Value)
    Loop
    If rs.RecordCount > 0 Then
        rs.MoveFirst
        rs.Sort = "RowNum"
        DoEvents
        rsOver5Days.Sort = "RowNum"
        DoEvents
        Do Until rs.RecordCount = 0
            RowNum = Trim(rs!RowNum) ' trim out of habit
            If Trim(rs!EditField) = 1 Then
                rsOver5Days.MoveFirst
                AddDays = 365
                Do Until rsOver5Days.EOF
                    ' we are only concerned with the "OVER 5 DAY" record that occurred AFTER the "Date Missed"
                    ' AND where the "OVER 5 DAY" record's "Start Date" <= (365 + number-of-over-5-day-periods)
                    ' -- which is a moving target, so-to-speak
                    If (CDate(Trim(rsOver5Days!StartDate)) > CDate(Trim(rs!StartDate)) And CDate(Trim(rsOver5Days!StartDate)) <= DateAdd("d", AddDays, CDate(Trim(rs!StartDate)))) Then
                        AddDays = AddDays + Trim(rsOver5Days!DiffDays)
                    End If
                    rsOver5Days.MoveNext
                Loop
                ' here we build the formulas that will appear in each of the cells.
                HFormula = "=IF($E$2-F" & RowNum & "<" & AddDays & ",G" & RowNum & ",0)"
                IFormula = "=IF(H" & RowNum & "=0,"""",IF(H" & RowNum & "<=2,0.25,IF(H" & RowNum & "<=4,0.5,IF(H" & RowNum & "<=6,0.75,IF(H" & RowNum & "<=7.99,1,IF(H" & RowNum & ">=8,H" & RowNum & "/8*1,""""))))))"
                NFormula = "=F" & RowNum & "+" & AddDays
                SelfEditing = True
                Range("H" & RowNum).Formula = HFormula
                Range("I" & RowNum).Formula = IFormula
                Range("N" & RowNum).Formula = NFormula
                SelfEditing = False
            Else
                HFormula = "=IF($E$2-F" & RowNum & "<365,G" & RowNum & ",0)"
                IFormula = "=IF(H" & RowNum & "=0,"""",IF(H" & RowNum & "<=2,0.25,IF(H" & RowNum & "<=4,0.5,IF(H" & RowNum & "<=6,0.75,IF(H" & RowNum & "<=7.99,1,IF(H" & RowNum & ">=8,H" & RowNum & "/8*1,""""))))))"
                NFormula = "=F" & RowNum & "+365"
                SelfEditing = True
                Range("H" & RowNum).Formula = HFormula
                Range("I" & RowNum).Formula = IFormula
                Range("N" & RowNum).Formula = NFormula
                SelfEditing = False
            End If
            rs.Delete adAffectCurrent
            DoEvents
            If rs.RecordCount > 0 Then
                rs.MoveNext
            End If
        Loop
    End If
    rsOver5Days.Close
    Set rsOver5Days = Nothing
    rs.Close
    Set rs = Nothing
End Sub

Private Function ParseCommentsForDate(DateLoc As Integer, SelectedRow As Integer, Delim As String) As String
    Dim ThruDate        As String
    Dim AllComments     As String
    Dim Count           As Integer
    Dim SearchString    As String
    
    On Error Resume Next
    DateLoc = DateLoc - 2 ' go back two characters from the position of the "/" in the comments
    If DateLoc <= 0 Then
        ParseCommentsForDate = ""
        Exit Function
    End If
    SearchString = "/" ' set a default value for searchstring so that it ENTERS the Do Loop
    ThruDate = ""
    Count = 0
    Do Until Trim(SearchString) = "" Or Count = 10
        SearchString = Mid(Trim(Range("K" & SelectedRow)), DateLoc, 1)
        If SearchString = Delim Or IsNumeric(SearchString) Then
            ThruDate = ThruDate & SearchString
        ElseIf Count = 0 Then
            SearchString = "/"
        End If
        Count = Count + 1
        DateLoc = DateLoc + 1
    Loop
    If IsDate(Trim(ThruDate)) Then
        ' move the date FROM the 'Reason' column and into the 'Thru Date' column
        AllComments = Range("K" & SelectedRow)
        AllComments = Replace(AllComments, Trim(ThruDate), "")
        SelfEditing = True
        Range("K" & SelectedRow).Value = AllComments
        Range("M" & SelectedRow).Value = Trim(ThruDate)
        SelfEditing = False
    End If
    ParseCommentsForDate = Trim(ThruDate)
End Function

I place a break point on this line:

    If Target.Count > 1 Then

and the breakpoint never gets hit.

HTH

Chew



10% of your life is what happens to you. 90% of your life is how you deal with it.

 

[strongm]

Just to confirm - you developed your code under Excel 2003. And it works as expected. When your user opens that exact same spreadsheet, it does not work?

Or are you getting the code to the user some other way?

 

[SkipVought]

And can this user run ANY procedures at all in this workbook?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[ChewDoggie]

Yes, I developed my code in Excel 2003 and the user is running Excel 2007, although she has both installed on her PC. I thought this was a "Trust Settings" issue that I guess is new to Excel 2007, but I just tried to open the file using 2003 and it still didn't hit the breakpoint in the code.

This workbook only has the one procedure running.

C.


10% of your life is what happens to you. 90% of your life is how you deal with it.

 

[strongm]

>but I just tried to open the file

And this is the exact file that you developed, sent to the user, have now got back and now does not work?

 

[SkipVought]

1. Please explain exactly what VBA Object this code resides in and runs from.

2. Can you see This Object in the Project Explorer? Explain what the tree-structure Parent Object is, relative to This Object.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}