Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 02-27-2012, 08:07 AM
Bondai Bondai is offline LOST: Dont know where to start Mac OS X LOST: Dont know where to start Office for Mac 2011
Novice
LOST: Dont know where to start
 
Join Date: Feb 2012
Posts: 3
Bondai is on a distinguished road
Default LOST: Dont know where to start

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
Reply With Quote
  #2  
Old 02-29-2012, 11:39 AM
Catalin.B Catalin.B is offline LOST: Dont know where to start Windows Vista LOST: Dont know where to start Office 2010 32bit
Expert
 
Join Date: May 2011
Location: Iaşi, Romānia
Posts: 386
Catalin.B is on a distinguished road
Default

try to separate part 5 from the rest of the code; The "P" entered by a macro
is not a worksheet_change event, like typing it .
So , at the end of part 3 of your code before End Sub, call this macro, with:
Code:
Call Date
You might need to call this macro from Private Sub Worksheet_Change too
Code:

sub Date()
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
end sub
Reply With Quote
  #3  
Old 03-01-2012, 06:05 AM
Bondai Bondai is offline LOST: Dont know where to start Mac OS X LOST: Dont know where to start Office for Mac 2011
Novice
LOST: Dont know where to start
 
Join Date: Feb 2012
Posts: 3
Bondai is on a distinguished road
Thumbs up Great

Thank you Catalin
I'll give it a go


Bondai
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
LOST: Dont know where to start Dont print header on first page jezh Word 1 02-01-2012 09:37 AM
LOST: Dont know where to start Dont Speak Spanish Dawneas Office 1 01-30-2011 10:39 PM
LOST: Dont know where to start I dont have Microsoft Office? JasonKoltai Office 1 09-26-2009 05:27 PM
LOST: Dont know where to start word shortcuts dont work glennc Word 4 08-10-2009 07:10 PM
Hyperlinks dont work iturnrocks Outlook 0 11-21-2006 10:19 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 07:21 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft