Posted to microsoft.public.excel.programming
|
|
Too much output... PLEASE HELP!
Tom, thank you very much for the help. I'll try using your amended code. I
suspected that the problem was as you stated, but couldn't seem to find a
way around it. As you can see, I'm no VBA expert. I appreciate the time you
spent working with this. Again, thanks.
Regards
Tom Barclay
"Tom Ogilvy" wrote in message
...
Here is a simple correction, although your code could be greatly reduce
using loops.
Option Explicit
Private Sub Worksheet_Change(ByVal target As Excel.Range)
Static cnt As Long
cnt = cnt + 1
Debug.Print cnt
Dim X As Integer
Dim VacationUsed As Integer, VacationLeft As Integer
Dim BonusDaysUsed As Integer, BonusDaysLeft As Integer
Dim FloatersUsed As Integer, FloatersLeft As Integer
Dim sStr As String
' Cell Number Format
Range("B10:H17").NumberFormat = "#,##0.00"
Range("B19:H21").NumberFormat = "#,##0.00"
Range("I10:N17").NumberFormat = "#,##0.00"
' Enter hours
Application.EnableEvents = False
For X = 10 To 16
Range("H" & X).Cells.Value = Range("B" & X).Cells.Value + _
Range("C" & X).Cells.Value + Range("D" & X).Cells.Value + _
Range("E" & X).Cells.Value + Range("F" & X).Cells.Value
Next X
' Calculate daily subtotals
If Not Intersect(target, Range("H10:H16")) Is Nothing Then
target.FormulaR1C1 = "=sum(RC[-6]:RC[-2])"
End If
' Calculate hour category subtotals
Range("B17").Cells.Value = Range("B10").Cells.Value + _
Range("B11").Cells.Value + Range("B12").Cells.Value + _
Range("B13").Cells.Value + Range("B14").Cells.Value + _
Range("B15").Cells.Value + Range("B16").Cells.Value
Range("C17").Cells.Value = Range("C10").Cells.Value + _
Range("C11").Cells.Value + Range("C12").Cells.Value + _
Range("C13").Cells.Value + Range("C14").Cells.Value + _
Range("C15").Cells.Value + Range("C16").Cells.Value
Range("D17").Cells.Value = Range("D10").Cells.Value + _
Range("D11").Cells.Value + Range("D12").Cells.Value + _
Range("D13").Cells.Value + Range("D14").Cells.Value + _
Range("D15").Cells.Value + Range("D16").Cells.Value
Range("E17").Cells.Value = Range("E10").Cells.Value + _
Range("E11").Cells.Value + Range("E12").Cells.Value + _
Range("E13").Cells.Value + Range("E14").Cells.Value + _
Range("E15").Cells.Value + Range("E16").Cells.Value
Range("F17").Cells.Value = Range("F10").Cells.Value + _
Range("F11").Cells.Value + Range("F12").Cells.Value + _
Range("F13").Cells.Value + Range("F14").Cells.Value + _
Range("F15").Cells.Value + Range("F16").Cells.Value
Range("G17").Cells.Value = Range("G10").Cells.Value + _
Range("G11").Cells.Value + Range("G12").Cells.Value + _
Range("G13").Cells.Value + Range("G14").Cells.Value + _
Range("G15").Cells.Value + Range("G16").Cells.Value
Range("H17").Cells.Value = Range("H10").Cells.Value + _
Range("H11").Cells.Value + Range("H12").Cells.Value + _
Range("H13").Cells.Value + Range("H14").Cells.Value + _
Range("H15").Cells.Value + Range("H16").Cells.Value
' Time and a half calculation for floating holidays
On Error Resume Next
sStr = ""
If Range("E10").Cells.Value + Range("B10").Cells.Value = 16 Then
Range("H10").Cells.Value = Range("H10").Cells.Value + 4
Range("H17").Cells.Value = Range("H17").Cells.Value + 4
sStr = sStr & fFloatComment(Range("A10"))
End If
If Range("E11").Cells.Value + Range("B11").Cells.Value = 16 Then
Range("H11").Cells.Value = Range("H11").Cells.Value + 4
Range("H17").Cells.Value = Range("H17").Cells.Value + 4
sStr = sStr & fFloatComment(Range("A11"))
End If
If Range("E12").Cells.Value + Range("B12").Cells.Value = 16 Then
Range("H12").Cells.Value = Range("H12").Cells.Value + 4
Range("H17").Cells.Value = Range("H17").Cells.Value + 4
sStr = sStr & fFloatComment(Range("A12"))
End If
If Range("E13").Cells.Value + Range("B13").Cells.Value = 16 Then
Range("H13").Cells.Value = Range("H13").Cells.Value + 4
Range("H17").Cells.Value = Range("H17").Cells.Value + 4
sStr = sStr & fFloatComment(Range("A13"))
End If
If Range("E14").Cells.Value + Range("B14").Cells.Value = 16 Then
Range("H14").Cells.Value = Range("H14").Cells.Value + 4
Range("H17").Cells.Value = Range("H17").Cells.Value + 4
sStr = sStr & fFloatComment(Range("A14"))
End If
If Range("E15").Cells.Value + Range("B15").Cells.Value = 16 Then
Range("H15").Cells.Value = Range("H15").Cells.Value + 4
Range("H17").Cells.Value = Range("H17").Cells.Value + 4
sStr = sStr & fFloatComment(Range("A15"))
End If
If Range("E16").Cells.Value + Range("B16").Cells.Value = 16 Then
Range("H16").Cells.Value = Range("H16").Cells.Value + 4
Range("H17").Cells.Value = Range("H17").Cells.Value + 4
sStr = sStr & fFloatComment(Range("A16"))
End If
Range("B26") = sStr & " worked"
' Shift differential hours
Range("A23").Value = Range("B17").Value
' Vacation used
Range("C23").Value = Range("O7").Value + Range("C17").Value
If Range("C23").Value = "" Then
Range("C23").Value = 0
End If
' Vacation left
Range("D23").Value = Range("O8").Value - Range("C17").Value
' Floating holidays used
Range("E23").Value = Range("O10").Value + Range("E17").Value / 8
' Floating holidays left
Range("F23").Value = Range("O11").Value - (Range("E17").Value / 8)
' Bonus days used
Range("G23").Value = Range("O13").Value + Range("F17").Value / 8
' Bonus days left
Range("H23").Value = Range("O14").Value - (Range("F17").Value / 8)
Application.EnableEvents = True
End Sub
Function fFloatComment(rng As Range)
Dim strDay As String
strDay = " (" & rng.Value & ")"
fFloatComment = strDay
End Function
Regards,
Tom Ogilvy
"Tom Ogilvy" wrote in message
...
It is because you call ffloatcontent for each row that has greater than
16.
the first time (enter 8 in E10), there is only one row, ffloatcontent is
called once
the entry is made in E11, now there are two rows that have 16, so it
is
called twice
the entry is made in E12, now there are three rows that have 16, so it
is
called three times
and so forth.
Regards,
Tom Ogilvy
"TB" wrote in message
...
Mark, thanks for looking at it. I think that the following is, in part
to
blame, but I'm guessing that it's interacting with something else
which
I
can't seem to track down, because I experienced the same symptoms when
writing a routine to transfer some other data related to the same
problem
range to a second worksheet.
strDay = " (" & ActiveCell.Offset(-1, -4).Value & ")"
Sheets(1).Range("B26").Value = Sheets(1).Range("B26").Value _
& strDay & " Worked."
If you can solve this, you'll be a life saver. Thanks
Regards
Tom Barclay
Mark Rosenkrantz wrote:
TB;
I see what you mean, but have to take some time to discover the
problem.
Mark Rosenkrantz.
More Excel ? www.rosenkrantz.nl or
----------------------------------------------------------------
"TB" wrote in message
...
I've been trying to get help with this problem for a couple of
weeks
now, but no one so far appears to see any problem with the output
in
cell B26. Could someone PLEASE paste the following code into a
worksheet module and run the code as follows to get an example of
my
problem:
in column A10 thru A16, enter sun thru sat (see diagram)
in column B10 thru B16, enter 8 in each cell (see diagram)
make cell B26 large (with wordwrap)
A B C D E
10 sun 8
11 mon 8
12 tue 8
13 wed 8
14 thu 8
15 fri 8
16 sat 8
When everything is ready, enter an 8 in cell E10, another in E11,
another in E12, etc. You'll see that the first 8 produces a single
"sun" output in B26 (this is what I want for each 8 entered in E
column). The second 8 adds two "mon" outputs, a third 8 adds three
"tue" outputs, etc. I need to know why it's doing this, and how the
code below can be changed to cause each 8 entered in column E to
add
a SINGLE output to the text already present in B26. Please help.
<snipped for brevity
|