VBA: Finding a cell address

[musoguy]

Hi there. I am a little stuck partway through a VBA code I am writing.

I have a worksheet that has a list of staff members in Column A and a list of how many classes they currently teach in Column B. The values in both Columns are pulled from other worksheets using calculations, so there is no physical user input on this sheet at all.

What I want to happen is if a cell in Column B changes to the value 5, then to get hold of the cell address to use in a msgbox.

All I have come up with so far is:

Private Sub Worksheet_Calculate()

    Select Case Range("B1").Value
    
        Case 5

            MsgBox (Worksheets("Sheet1").Range("A1").Value) & " now has 5 classes.", vbExclamation, "WARNING"


    End Select

Which works fine, but I have 100 rows of data, and presumably if I write 100 Select Cases it will slow the workbook down. Plus, when I added a second Select Case the Msgboxs went crazy! I thought a Worksheet_Calculate event only happened if a formula result changed but it started firing a msgbox every time I came out of a cell anywhere in the workbook. Stumped (but trying!)

James

 

[Michael M]

Hi James
Maybe something like

Sub worksheet_selectionchange(ByVal target As Range)
Dim i As Long, lr As Long, rngarea As Range
Set rngarea = Range("A1:B7")
If Application.Intersect(target, rngarea) Is Nothing Then
Exit Sub
End If
lr = Cells(Rows.Count, "A").End(xlUp).Row
    For i = lr To 1 Step -1
        If Range("B" & i).Value >= 5 Then
            MsgBox (Worksheets("Sheet1").Range("A" & i).Value) & " now has 5 classes.", vbExclamation, "WARNING"
        End If
    Next i
End Sub

 

[AlphaFrog]

Have you considered using Conditional Formatting to just change the background color of any cell in column B to Red (or whatever color you want) when the value is >5 ?

 

[musoguy]

Thanks for the reply Michael.

I tried your code and it doesn't seem to work. Any idea why?


AlphaFrog, I actually have already done what you recommended. Trouble is when a staff member reaches five classes, the user will be inputting the data on a separate sheet, so may not realize until too late. So I am trying to do both to cover their bases.

 

[AlphaFrog]

The code below will run when the user makes a change to column C on any worksheet except "Sheet1".

If the user changes column C on any sheet except Sheet1, and column B on Sheet1 has a 5, then the message box returns the name in column A of the matched 5.

Put the code in the ThisWorkbook module...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim Found As Range
    
    If Sh.Name <> "Sheet1" Then
        If Not Intersect(Sh.Range("[COLOR="Red"]C:C[/COLOR]"), Target) Is Nothing Then
            Set Found = Sheets("Sheet1").Range("[COLOR="Blue"]B:B[/COLOR]").Find([COLOR="Green"]5[/COLOR], , xlValues, xlWhole)
            If Not Found Is Nothing Then
                MsgBox Found.Offset(0, -1).Value & " now has [COLOR="Green"]5[/COLOR] classes.", vbExclamation, "WARNING"
            End If
        End If
    End If
    
End Sub

 

[musoguy]

Thanks for the reply. Trouble with the code you wrote for the purposes of my workbook, is that the number created in Column B comes from a CountA function, counting occurrences on two separate worksheets, from Columns A to AH. Any one of these cells updating can cause a cell in Column B in the target worksheet to become the number 5. Is there any way to broaden the trigger?

 

[Ralajer]

James, here is another approach to solving your problem. It requires a helper cell and column. The code would be in "sheet1". It is solely dependent on the calculation results so it should be fairly general

Private Sub Worksheet_Calculate()
    Dim oldSum As Integer, newSum As Integer, thresholdNo As Integer
    Dim rng As Range, cell As Range

    Set rng = Range(Range("B2"), Range("B2").End(xlDown))

'// Test if anything has changed by comparing sum of classes saved in helper cell D2
    '// with sum calculated on execution of this code
    
'// ASSUMES that multiple changes done concurrently don't cancel net a zero change.
    '// Dependant on how calculations are setup.
    
    oldSum = Range("D2").Value
    newSum = Application.WorksheetFunction.Sum(rng)

    If oldSum = newSum Then Exit Sub        '// If sums match then Nothing has changed

    Application.Calculation = xlCalculationManual   '// Turn off automatic sheet calculation
    
    thresholdNo = 5      '// Warning threshold for number of classes.

    Range("D2").Value = newSum  '// Set helper cell to new sum
    
    '// Loop through range looking for changes in values
    For Each cell In rng
        '// Requires a helper column one right (C:C) of number of classes
        If cell.Value <> cell.Offset(0, 1).Value Then
            '// Update helper column cell to calc column cell
            cell.Offset(0, 1).Value = cell.Value
            
            '// Display message box if changed cell >= to threshold
            If cell.Value >= thresholdNo Then
                MsgBox _
                    prompt:=cell.Offset(0, -1).Value _
                        & " now has " _
                        & cell.Value _
                        & " classes.", _
                    Buttons:=vbExclamation, _
                    Title:="WARNING"
            End If
            '// Exit For 'If only one change is possible. Helper column would have to be setup first
        End If
    Next cell
    
    Application.Calculation = xlCalculationAutomatic    '// Turn on automatic sheet calculation

End Sub

Most of the explanation is in the code comments. It only gives a warning once so if it is ignored it won't show up again until the 6th class is added. Let me know if you have any questions.

 

[AlphaFrog]

Thanks for the reply. Trouble with the code you wrote for the purposes of my workbook, is that the number created in Column B comes from a CountA function, counting occurrences on two separate worksheets, from Columns A to AH. Any one of these cells updating can cause a cell in Column B in the target worksheet to become the number 5. Is there any way to broaden the trigger?

If Not Intersect(Sh.Range("[COLOR="Red"]A:AH[/COLOR]"), Target) Is Nothing Then

A user can really change any value in columns A to AH ?

 

[musoguy]

Thank you for your help Rob.

Quick question, in the actual worksheet, there are 4 columns. Column A is what I said it was. What I said was in Column B is actually in Column D. I was just simplifying, but have now realized that I am not sure how to adjust the code! Hoping you wouldn't mind modifying it for me. Thanks again for your help

James

 

[Ralajer]

Here is the modified code.

Private Sub Worksheet_Calculate()
    Dim oldSum As Integer, newSum As Integer, thresholdNo As Integer
    Dim rng As Range, cell As Range
    Set rng = Range(Range("D2"), Range("D2").End(xlDown))

'// Test if anything has changed by comparing sum of classes saved in helper cell F2
    '// with sum calculated on execution of this code
    
'// ASSUMES that multiple changes done concurrently don't cancel net a zero change.
    '// Dependant on how calculations are setup.
    
    oldSum = Range("F2").Value
    newSum = Application.WorksheetFunction.Sum(rng)

    If oldSum = newSum Then Exit Sub        '// If sums match then Nothing has changed

    Application.Calculation = xlCalculationManual   '// Turn off automatic sheet calculation
    
    thresholdNo = 5      '// Warning threshold for number of classes.
    
    Range("F2").Value = newSum  '// Set helper cell to new sum
    
    '// Loop through range looking for changes in values
    For Each cell In rng
        '// Requires a helper column one right (E:E) of number of classes
        If cell.Value <> cell.Offset(0, 1).Value Then
            '// Update helper column cell to calc column cell
            cell.Offset(0, 1).Value = cell.Value
            
            '// Display message box if changed cell >= to threshold
            If cell.Value >= thresholdNo Then
                MsgBox _
                    prompt:=cell.Offset(0, -3).Value _
                        & " now has " _
                        & cell.Value _
                        & " classes.", _
                    Buttons:=vbExclamation, _
                    Title:="WARNING"
            End If
            '// Exit For 'If only one change is possible. Helper column would have to setup first
        End If
    Next cell
    
    Application.Calculation = xlCalculationAutomatic    '// Turn on automatic sheet calculation

End Sub