Microsoft Office Forums - View Single Post

Bondai · 02-27-2012, 08:07 AM

Hi all

Im really new to VB code and already feel totally overwhelmed by all the options

I'm developing a spreadsheet/worksheet which uses a lot of VB code to enable as much automation as possible and through trawling the net and looking and testing a wide variety of code from various sites I have got some good news in that the worksheet is starting to do what I want it to but its not quite right and I was hoping someone may be kind enough to look at the code I have used and advise where it needs to change.

I think I may only need to give you guys the area of code where it is going wrong but I understand that may cause additional errors if you are unaware what code is also in use. So in this sense I have included everything below and I apologise in advance if this is really annoying or needlessly long winded.

SUMMARY

PART 1 = Allows and adds multiple pre-defined items in the same cell using a drop down list
(a combination of Data - Validation and VB code).
THIS WORKS FINE

PART 2 = Automatically adds a static date to a specified cell when PART 1 drop down list is used. The date is automatically cleared if the text in the linked cell (from dropdown list cell is cleared).
THIS WORKS FINE

PART 3 = A Double-click command. Changes cells in a specified row range - RED with an "X" and GREEN with a "P" Doubleclick once to change to RED with "X" and Doubleclick again to change cell to GREEN with "P"
THIS WORKS FINE

PART 4 = A Right-click command. Changes cells as specified in PART 3 back to nothing and clears the cell(s) when any x1 of them is right-clicked.
THIS WORKS FINE

PART 5 = Automatically adds a static date to a specified cell when any x1 of the cells specified in PART 3/4 contains the value "P"
THIS DOES NOT WORK AS PLANNED
THIS WORKS FINE IF THE LETTER "P" IS TYPED INTO THE CELL BUT NOT IF THE CELL IS DOUBLE-CLICKED AND THE "P" IS AUTOMATICALLY ENTERED.

T H E C O D E

NOTE: You will notice that PART 5 of the code follows PART 1 rather than PART 4 (this is because both PARTS 1 and 5 were supplied using the Option Explicit (command / function ?) and I could not get them to work together without adding PART 5 to PART 1 (I hope that makes sense).PART 1: (developed and supplied by Contextures Inc / www.contextures.com)
-----------------------------------------------------------------------
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 19 Then 'insert correct column number
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
End If

exitHandler:
Application.EnableEvents = True

'PART 5: (supplied in kindness by a regular user at another site)

Dim cell As Range

For Each cell In Target
If Not Intersect(cell, Range("H:Q")) Is Nothing Then
If UCase(cell) = "P" Then
Application.EnableEvents = False
Range("T" & cell.Row) = Now
Application.EnableEvents = True
End If
End If
Next cell

'PART 2:

With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("E4:E119"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "dd/mm/yy - hh:mm:ss"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With

End Sub

'PART 3:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, Range("H4:Q119")) Is Nothing Then
Exit Sub
End If

If Target.Interior.ColorIndex = xlNone Then
Target.Interior.ColorIndex = 3
Target = "X"

ElseIf Target.Interior.ColorIndex = 3 Then
Target.Interior.ColorIndex = 4
Target = "P"

ElseIf Target.Interior.ColorIndex = 4 Then
Target.Interior.ColorIndex = 3
Target = "X"

End If

Cancel = True

End Sub

'PART 4:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, Range("H4:Q119")) Is Nothing Then
Exit Sub
End If

If Target.Interior.ColorIndex = 3 Then
Target.Interior.ColorIndex = xlNone
Target = vbNullString

ElseIf Target.Interior.ColorIndex = 4 Then
Target.Interior.ColorIndex = xlNone
Target = vbNullString

End If

Cancel = True

End Sub

----------

So in all. I need PART 5 to insert the date when the cell contains a "P" regardless of it being entered by typing or if the cell is double clicked as in PART 3.

I really hope this makes sense. I'm not expecting a huge response but if anyone can advise anything at all that would be highly appreciated.

Many thanks
Bondai