Solved: Target.Offset Function

[hobbiton73]

Hi, I wonder whether someone may be able to help me please.

I'm using the attached file to monitor staff resource forecasting.

If you open up the file, and enter your name in column "B" you will see that a number of cells are popluated with text values. These act as prompts which aid the user when completing the sheet.

The problem I have involves columns "I", "J" and "K". After entering your name, please select "P" from the drop down menu in column "I". This in turn will popluate columns "J" and "K" with the text values "Enter the Project Code" and "Enter the name of the Project" respectively.

The issue I have, is that when I then enter any value in column "J", the "Enter the name of the Project" text disappears from column "K". but I need this text to be present until the user enters a value in the cell.

This is the piece of code which deals with the popluation of columns "J" and "K".

If Target.Column = 9 Then
If Target.Value = "P" Then
Target.Offset(, 1).Value = "Enter the Project Code"
Target.Offset(, 2).Value = "Enter the name of the Project"
End If
End If
I've been working on this for weeks, but I just can;t seem to find a solution.

I just wondered whether someone could possibly take a look at this please and let me know where I'm going wrong.

Many thanks and kind regards

Chris

[Kenneth Hobs]

When using 3 or more Ifs, one needs to consider IF using Select Case might be a better choice.

I have not tested this but see if this helps isolate your problem.
Option Explicit
Public preValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range, res As Variant
Dim rCell As Range
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim lr As Long

If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo EndNow
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.EnableCancelKey = xlDisabled
lr = lr

With Target
Select Case True
Case .Column = 3
If .Value = "No" Then _
MsgBox "Please remember to make the same change to all rows for " & .Offset(0, -1).Value2 & " and delete any future forecasts"

Case Intersect(Target, Range("B5:AD400", "AF5:AQ400")) Is Nothing
If .Value2 <> preValue And .Value2 <> "" Then
With Rows(lr)
.Range("A1").Value = Date
If Target.Column <> 3 Then .Range("C1").Value2 = "--Select--"
End With
.Interior.ColorIndex = 35
Columns(.Column).AutoFit
End If

Case .Column = 45
If .Value = "Yes" Then
Set Rng1 = Application.Union(Cells(lr, "B").Resize(, 19), Cells(lr, "R"))
Rng1.Interior.ColorIndex = xlNone
Set Rng2 = Application.Union(Cells(lr, "S").Resize(, 12), Cells(lr, "AD"))
Rng2.Interior.ColorIndex = 37
Set Rng3 = Application.Union(Cells(lr, "AF").Resize(, 12), Cells(lr, "AQ"))
Rng3.Interior.ColorIndex = 42
End If

Case Not Intersect(Target, Range("J7:J400")) Is Nothing
Set Cell = Worksheets("Lists").Range("B2:C23")
res = Application.VLookup(Target, Cell, 2, False)
If IsError(res) Then
Range("K" & lr).Value2 = ""
Else
Range("K" & lr).Value2 = res
End If

Case .Column = 2
If .Value2 > 0 Then
.Offset(, 2).Value2 = "Enter your Grade"
.Offset(, 3).Value2 = "Enter your Job Role"
.Offset(, 4).Value2 = "--Select--"
.Offset(, 6).Value2 = "R&D"
.Offset(, 7).Value2 = "--Select--"
.Offset(, 16).Value2 = "Enter the name of your Line Manager"
End If

Case .Column = 9
If .Value2 = "P" Then
.Offset(, 1).Value2 = "Enter the Project Code"
.Offset(, 2).Value2 = "Enter the name of the Project"
End If

Case Else
End Select
End With

EndNow:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.EnableCancelKey = xlInterrupt
End Sub

[Aflatoon]

This section
If Not Intersect(Target, Range("J7:J400")) Is Nothing Then
Set Cell = Worksheets("Lists").Range("B2:C23")
res = Application.VLookup(Target, Cell, 2, False)
If IsError(res) Then
Range("K" & Target.Row).Value = ""
Else
Range("K" & Target.Row).Value = res
End If
End If

is clearing the values in K unless you enter a value which has a match on the lists table and also has an entry in column C of the lists table.

Additionally, you really ought to disable events whenever your code changes a cell since you will trigger the change event again if you do not.

[hobbiton73]

Hi @Kenneth Hobs, thnak you for taking the time to reply to my post and for putting the solution together for me.

Your script works in respect of the cell text values, thank you, but unfortunately, this piece of code no longer works:

.Interior.ColorIndex = 35
Columns(.Column).AutoFit

Many thanks and kind regards

Chris

[Kenneth Hobs]

with Target
.Interior.ColorIndex = 35
Columns(.Column).AutoFit
End With

[hobbiton73]

Hi @Kenneth Hobs, thank you for coming back to me so quickly with this.

If I've understood this correctly, I've changed this section of code:

Case Intersect(Target, Range("B5:AD400", "AF5:AQ400")) Is Nothing
If .Value2 <> preValue And .Value2 <> "" Then
With Rows(lr)
.Range("A1").Value = Date
If Target.Column <> 3 Then .Range("C1").Value2 = "--Select--"
End With
.Interior.ColorIndex = 35
Columns(.Column).AutoFit
End If

to:

Case Intersect(Target, Range("B5:AD400", "AF5:AQ400")) Is Nothing
If .Value2 <> preValue And .Value2 <> "" Then
With Rows(lr)
.Range("A1").Value = Date
If Target.Column <> 3 Then .Range("C1").Value2 = "--Select--"
End With
With Target
.Interior.ColorIndex = 35
Columns(.Column).AutoFit
End With

If this is correct, then unfortunately the cell shading doesn't work.

Many thanks and kind regards

Chris

[Kenneth Hobs]

I think you need NOT?

Case Not Intersect(Target, Range("B5:AD400", "AF5:AQ400")) Is Nothing

[hobbiton73]

Hi @Kenneth Hobs, thank you very much for sending this.

Unfortunately when I insert "Not", the text values no longer populate the pre-selected columns.

Would it help if I posted my updated file?

Many thanks and kind regards

Chris

[hobbiton73]

Hi @Aflatoon, thank you for taking the time to reply to my post and for the guidance.

I'll see whether I can integrate this into @Kenneth Hobbs' solution.

Kind regards

Chris

[Kenneth Hobs]

You can always break a Case out to an IF or another Select Case if that is needed.

[david000]

I would consider taking the majority of the case statements and breaking them up into subroutines in their own module and calling them to the worksheet event code.

Case something
Call macro A
Case somethin else
Call macro B

This could make it a whole lot easier to manage and figure out which line is causing havoc or not doing what it's supposed to do.

[hobbiton73]

All,

After working on this througout the morning, I've finally managed to get this to Work.

Using @Kenneth Hob's solution as a starting point, I've changed the code to:

Option Explicit
Public preValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range, res As Variant
Dim rCell As Range
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim lr As Long

If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo EndNow
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.EnableCancelKey = xlDisabled
lr = lr

If Target.Column = 3 Then
If Target = "No" Then MsgBox "Please remember to make the same change to all rows for " & Target.Offset(0, -1).Value & " and delete any future forecasts"
End If

If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next

If Not Intersect(Target, Range("B5:AD400", "AF5:AQ400")) Is Nothing Then
If Target.Value <> preValue And Target.Value <> "" Then
Application.EnableEvents = False
With Rows(Target.Row)
.Range("A1").Value = Date
.Range("AS1").Value = "No"
If Target.Column <> 3 Then .Range("C1") = "--Select--"
End With
Application.EnableEvents = True
Target.Interior.ColorIndex = 35
Columns(Target.Column).AutoFit
End If
End If

With Target
Select Case True
Case .Column = 45
If .Value = "Yes" Then
Set Rng1 = Application.Union(Cells(lr, "B").Resize(, 19), Cells(lr, "R"))
Rng1.Interior.ColorIndex = xlNone
Set Rng2 = Application.Union(Cells(lr, "S").Resize(, 12), Cells(lr, "AD"))
Rng2.Interior.ColorIndex = 37
Set Rng3 = Application.Union(Cells(lr, "AF").Resize(, 12), Cells(lr, "AQ"))
Rng3.Interior.ColorIndex = 42
End If

Case Not Intersect(Target, Range("J7:J400")) Is Nothing
Set Cell = Worksheets("Lists").Range("B2:C23")
res = Application.VLookup(Target, Cell, 2, False)
If IsError(res) Then
Range("K" & lr).Value2 = ""
Else
Range("K" & lr).Value2 = res
End If

Case .Column = 2
If .Value2 > 0 Then
.Offset(, 2).Value2 = "Enter your Grade"
.Offset(, 3).Value2 = "Enter your Job Role"
.Offset(, 4).Value2 = "--Select--"
.Offset(, 6).Value2 = "R&D"
.Offset(, 7).Value2 = "--Select--"
.Offset(, 16).Value2 = "Enter the name of your Line Manager"
End If

Case .Column = 9
If .Value2 = "P" Then
.Offset(, 1).Value2 = "Enter the Project Code"
.Offset(, 2).Value2 = "Enter the name of the Project"
End If

Case Else
End Select
End With

EndNow:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.EnableCancelKey = xlInterrupt
End Sub

Many thanks to all, especially @Kenneth Hobs, for taking the time to help me out.

Kind regards and a very happy New Year to all.

Chris