Controls or Macros

[sbowen1986]

Hi There,

I'm working on a spreadsheet that has over 1,000 rows. Only about 20 columns. I'd like to somehow have about 4 columns in each row say something when something occurs (this will make more sense, please read on). They way i'd viewed this originally was using an IF formula where IF column J = Yes then column D and E need to say "VACANT", column K = "YES" and column P = "N/A". However, i very quickly realised that wouldn't work because when column J = NO, i want free text to be added (it is names of employees so can not be a list).

I had a look at using ActiveX controls. Which work. I added a button or checklist with the following:

Range ("D2"). Value = "VACANT"
Range ("E2"). Value = "VACANT"
Range ("K2"). Value = "YES"
Range ("P2"). Value = "N/A"
Now as i say, this works with one problem. When i drag it down to the other rows, it still references row 2. Meaning that if i want the button to work throughout, i'd need to go into each of the 1,000 odd rows and change the row it is referring too.

Can anyone help? This is the first time I've used this functionality so please treat me like an idiot when discussing these things.

 

[StephenCrump]

Welcome to the Forum!

The code below uses a Worksheet_Change event to do this:
- If the user changes column J to "YES", the code will write values in columns D, E, K and P
- If the user changes column J to any other value, the code will clear columns D, E, K and P

I am assuming it's the user that changes column J? If it's a formula, we'll need to use the Worksheet_Calculate event instead.

Assuming you want the code to work in Sheet1 (note this is the codename, not the name that appears on the Excel sheet tab), the code will need to go in the Sheet1 module (not a code module).

'In Sheet1 module
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngToChange As Range, r As Range
    Const StartRow = 2  'say
    
    Set rngToChange = Intersect(Target, Range("J" & StartRow).Resize(Range("A" & Rows.Count).End(xlUp).Row - StartRow + 1)) 'assumes col A is fully populated?
    
    If Not rngToChange Is Nothing Then
        Application.ScreenUpdating = False
        For Each r In rngToChange
            If UCase(r.Value) = "YES" Then
                r.Offset(, -6).Resize(, 2).Value = "VACANT"
                r.Offset(, 1).Value = "YES"
                r.Offset(, 6).Value = "N/A"
            Else
                r.Offset(, -6).Resize(, 2).ClearContents
                r.Offset(, 1).ClearContents
                r.Offset(, 6).ClearContents
            End If
        Next r
        Application.ScreenUpdating = True
    End If

End Sub