View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Stuck - VB Help needed

I asumed you put the message box at the 1st line of the macro. if you are
not seeing the message box either there is something wrong with the data or
another macro is causing an error. I would need to see the data to determine
what the probelm is.

You could add a break point on the worksheet change line in your macro.
click on this line with mouse and press F9. the line should change color.
First make sure you get to the break point when the macro is working. Press
F5 to continue after getting to the break point. Doing this will tell us if
the data is bad (gets to this line) or something else in the workbook is
failing (doesn't get to the line).

The hour will has nothing to do with the function being called. After we
find out why the macro isn't runni9ng then we have to address the hour issue.
I would need to see samples of the data to determine if the hour is needed.
It is only needed if you have a cell formated as time.

You also need to change the function to add a loop since yo are changing
more than one value in the range. When you change J4 you are also changing
K4 so the function need to loop. Exscel does all the calculattions on the
worksheet before calling the worksheet change function.

Private Sub Worksheet_Change(ByVal Target As Range)
MyBlue = 5
MyGreen = 4
MyBrown = 18
MyBlack = 1
MyGrey = 15

MyWhite = 2

Application.EnableEvents = False

Set i = Range("I4:K20")
For Each t In Target

If Intersect(t, i) Is Nothing Then Exit Sub

BadColor = False
Select Case UCase(Cells(t.Row, "I"))

Case "BLUE": MyBack = MyBlue
MyWhite = MyBlack
Case "GREEN": MyBack = MyGreen
MyFont = MyBlack
Case "BROWN": MyBack = MyBrown
MyFont = MyBlack
Case "BLACK": MyBack = MyBlack
MyFont = MyWhite
Case "GREY": MyBack = MyGrey
MyFont = MyBlack
Case Else
' color is no good
BadColor = True
End Select

'clear old colors
Range(Cells(t.Row, "k"), Cells(t.Row, "k").Offset(0, 23)) _
.Interior.ColorIndex = xlColorIndexNone
'make font black
Range(Cells(t.Row, "k"), Cells(t.Row, "k").Offset(0, 23)) _
.Font.ColorIndex = MyBlack

StartTime = Cells(t.Row, "J")
EndTime = Cells(t.Row, "K")
If BadColor = False Then
If StartTime < "" And _
IsNumeric(StartTime) Then

'Start time is valid
If EndTime < "" And _
IsNumeric(EndTime) Then

'both starttime and end time are good
Range(Cells(t.Row, "L").Offset(0, StartTime), _
Cells(t.Row, "L").Offset(0, EndTime)).Interior.ColorIndex = MyBack
Range(Cells(t.Row, "L").Offset(0, StartTime), _
Cells(t.Row, "L").Offset(0, EndTime)).Font.ColorIndex = MyFont
Else
'Start Time good end time not good
Cells(t.Row, "L").Offset(0, StartTime).Interior.ColorIndex =
MyBack
Cells(t.Row, "L").Offset(0, StartTime).Font.ColorIndex = MyFont
End If
Else

If EndTime < "" And _
IsNumeric(EndTime) Then

'Start time no good, end time good
Cells(t.Row, "L").Offset(0, EndTime).Interior.ColorIndex = MyBack
Cells(t.Row, "L").Offset(0, EndTime).Font.ColorIndex = MyFont
Else
'start time and end time no good
End If
End If
End If
Next t
Application.EnableEvents = True
End Sub


"LiAD" wrote:

Yes correct. I see no message box.

All worksheet options work correctly. There are no other macros etc in this
workbook, just cells filled with text, raw numbers and the formulas in
question.

Yes if I change the formula back to a number it works no problems again.

Changing the error trapping has not shown any issues or errors any time I've
tried to run it. I see no messages in excel or VB, it just doesnt seem to
work with formulas.

Do you think the Hour() bit is important? I dont see why this should be
time related problem as its just dealing with numbers. I have tried it but
no luck.

"joel" wrote:

I assume yo are NOT getting the messagebox. Is this correct?

The worksheet function shold always work unless you are getting an error in
antoerh macro. You said the only thing you changed was the number to a
formula. this means you worksheet options are working correctly.

Does the macro start working again if yo only change the formulas back to a
number? I want to make sure that events weren't disabled.

Try changing your error trapping in the VBA menu

Tools - OPtions - General - Stop on all errors

This will give additional diagnostics to help solve the problem.

Post the data in cells J4, G4, and K4.



"LiAD" wrote:

All the data is on one worksheet.

There is no problem with data entered as numbers.

The problem is only with data generated by formulas, for example if in cell
K4 I put = J4 + G4 then I change the value in G4 the gantt will not update to
the new value in K4.

The function is working fine if I dont use formulas in the worksheet.

"joel" wrote:

Is the problem with formulas or the data. Put a message box a the beginning
of the worksheet change to see if yo are getting into the function. Also,
are you formulas referecing other worksheets? worksheet change only apply to
the sheet where they are located.

Private Sub Worksheet_Change(ByVal Target As Range)
msgbox("Data : " & target &"; Addr : " & Target.address)
MyBlue = 5


"LiAD" wrote:

Thanks a lot for trying.

Unfortunately I cant get that to drive it either. Again formulas update but
not the gantt.


"joel" wrote:

I think I figured out the problem. 1 hour is not 1 but 1/24. Time in excel
is one day = 1.

Try this fix

from
StartTime = Cells(t.Row, "J")
EndTime = Cells(t.Row, "K")

to:
StartTime = Hour(Cells(t.Row, "J"))
EndTime = Hour(Cells(t.Row, "K"))


"LiAD" wrote:

Morning,

I have a code that reads three columns, colour (black, blue, green, brown
and two numbers, start hours and finish hours, (1, 2, 3 etc). The code then
plots a series of coloured boxes, one colour per row to produce a gant chart.

It works fine if I enter the three input columns manually, but if I drive
the hour columns through formulas the coloured lines do not update with
changes. So for example I want to plot blue from 0 to 3 hours on row 4 and
black from 5 to 7 hours on row 5. Enter the data hit return and it works, I
get a blue bar four boxes long starting in L4 and a black one 3 boxes long
starting in P5.

Then I change the row 5 inputs to be;

start time = finish time of row 4 + 1
end time = start time + 3

Any changes to the row 4 inputs will not update the gantt, although the
values in cells driving the gantt will change.

Can anyone help me know why this happens or how to fix it?

The code I'm using is below if it helps.

Thanks
LiAD

Private Sub Worksheet_Change(ByVal Target As Range)
MyBlue = 5
MyGreen = 4
MyBrown = 18
MyBlack = 1
MyGrey = 15

MyWhite = 2

Set i = Range("I4:K20")
Set t = Target
If Intersect(t, i) Is Nothing Then Exit Sub

Application.EnableEvents = False
Select Case UCase(Cells(t.Row, "I"))
Case "BLUE": MyBack = MyBlue
MyWhite = MyBlack
Case "GREEN": MyBack = MyGreen
MyFont = MyBlack
Case "BROWN": MyBack = MyBrown
MyFont = MyBlack
Case "BLACK": MyBack = MyBlack
MyFont = MyWhite
Case "GREY": MyBack = MyGrey
MyFont = MyBlack
Case Else
Exit Sub ' color is no good
End Select

'clear old colors
Range(Cells(t.Row, "k"), Cells(t.Row, "k").Offset(0, 23)) _
.Interior.ColorIndex = xlColorIndexNone
'make font black
Range(Cells(t.Row, "k"), Cells(t.Row, "k").Offset(0, 23)) _
.Font.ColorIndex = MyBlack


StartTime = Cells(t.Row, "J")
EndTime = Cells(t.Row, "K")
If StartTime < "" And _
IsNumeric(StartTime) Then

'Start time is valid

If EndTime < "" And _
IsNumeric(EndTime) Then

'both starttime and end time are good
Range(Cells(t.Row, "L").Offset(0, StartTime), _
Cells(t.Row, "L").Offset(0, EndTime)).Interior.ColorIndex = MyBack
Range(Cells(t.Row, "L").Offset(0, StartTime), _
Cells(t.Row, "L").Offset(0, EndTime)).Font.ColorIndex = MyFont
Else
'Start Time good end time not good
Cells(t.Row, "L").Offset(0, StartTime).Interior.ColorIndex = MyBack
Cells(t.Row, "L").Offset(0, StartTime).Font.ColorIndex = MyFont
End If
Else

If EndTime < "" And _
IsNumeric(EndTime) Then

'Start time no good, end time good
Cells(t.Row, "L").Offset(0, EndTime).Interior.ColorIndex = MyBack
Cells(t.Row, "L").Offset(0, EndTime).Font.ColorIndex = MyFont
Else
'start time and end time no good
End If

End If

Application.EnableEvents = True
End Sub