Shrink Code in module

[access101]

I want to shrink the following if possible is there a for or a loop that can run through this? Any help would be appreciated. Thanks

Function StartShift(ByVal T, ByRef Y, Z, X)
If X("S" & T) = #6:15:00 AM# Then
A = A - 0.23
B = B - 0.23
C = C + 0.23
S = #6:15:00 AM#
EndShift A, B, C, T, S, Y, Z, X
End If

If X("S" & T) = #6:30:00 AM# Then
A = A - 0.4
B = B - 0.4
C = C + 0.4
S = #6:30:00 AM#
EndShift A, B, C, T, S, Y, Z, X
End If

this code repeats until 12 am

 

[MajP]

Public Sub startShift()
Dim shiftTime As Date
Dim interval As Integer
Dim change As Single
Const startTime = #6:15:00 AM#

shiftTime = x("S" & T)
If shiftTime >= #6:15:00 AM# And shiftTime <= #12:00:00 PM# And Minute(shiftTime) Mod 15 = 0 Then
interval = DateDiff("n", startTime, shiftTime) / 15
change = 0.23 + 0.17 * interval
Debug.Print interval & " " & change
' A = A - change
' B = B - change
' C = C - change
'S = x
'EndShift A, B, C, T, S, Y, Z, X
End If
End Sub

 

[MajP]

Public Sub startShift()
  Dim shiftTime As Date
  Dim interval As Integer
  Dim change As Single
  Const startTime = #6:15:00 AM#
  
  shiftTime = x("S" & T)
  If shiftTime >= #6:15:00 AM# And shiftTime <= #12:00:00 PM# And Minute(shiftTime) Mod 15 = 0 Then
   interval = DateDiff("n", startTime, shiftTime) / 15
   change = 0.23 + 0.17 * interval
   Debug.Print interval & " " & change
  ' A = A - change
  ' B = B - change
  ' C = C - change
   'S = shiftTime
   'EndShift A, B, C, T, S, Y, Z, X
 End If
End Sub

 

[randy700]

With the information in your question, I'd say no.
The code does not really repeat itself, because the formulas for A B C and S are different.

Is there some kind of pattern involved?


Randy

 

[MajP]

That was a big assumption on my part that the value changed incremented by .17

.23, .4, .57, .74 ...

If that is not the case you would need to show the whole pattern. If there is not pattern, then you would add a select case instead.

Public Sub startShift()
  Dim x As Date
  Dim interval As Integer
  Dim change As Single
  Const startTime = #6:15:00 AM#
  x = x("S" & T)
  change = getChange(X)
  if change <> 0 then
    ' A = A - change
    ' B = B - change
    ' C = C - change
    ' S = x
    ' EndShift A, B, C, T, S, Y, Z, X
 End If
End Sub

Public Function GetChange(dtm As Date) As Single
  Select Case dtm
  Case #6:15:00 AM#
    GetChange = 0.23
  Case #6:30:00 AM#
    GetChange = 0.4
  '...
  'Case #12:00:00 PM #
  End Select
End Function

 

[access101]

ok MajP your code works great! now I have one more issue.
Below is my Endshift function so before i used your code when i enter a start time 6am X("Box" & T).Left would move and if i entered an end time of 1pm X("Box" & T).Width would resize.
Now if i change it to 6:15am to 1pm X("Box" & T).Left moves the entire box. Sorry if this is confusing this is the final piece i need to get this working let me know if you need more detail. Thanks

Function StartShift(ByVal T, ByRef Y, Z, X)
Dim shiftTime As Date
Dim interval As Integer
Dim change As Single
Const startTime = #6:00:00 AM#

A = 2.42 'Box Width 10 am
B = 1 'Box Width 1 pm
C = 2.8646 'Box Left Margin

shiftTime = X("S" & T)
If shiftTime >= #6:00:00 AM# And shiftTime <= #7:00:00 PM# And Minute(shiftTime) Mod 15 = 0 Then
interval = DateDiff("n", startTime, shiftTime) / 15
change = -0.195 * interval

A = A '- change
B = B '- change
C = C - change
S = shiftTime
EndShift A, B, C, T, S, Y, Z, X
End If
End Function

Function EndShift(ByRef A, B, C, T, S, Y, Z, X)
S = S
E = E
A = A
B = B
C = C
T = T
Y = Y

X("Box" & T).Left = C * 1440
If X("E" & T) = #10:00:00 AM# Then
X("Box" & T).Width = A * 1440
E = #10:00:00 AM#
X("Box" & T).Left = C * 1440

ElseIf X("E" & T) = #10:15:00 AM# Then
X("Box" & T).Width = (A + 0.37) * 1440
E = #10:15:00 AM#
X("Box" & T).Left = C * 1440

ElseIf X("E" & T) = #10:30:00 AM# Then
X("Box" & T).Width = (A + 0.74) * 1440
E = #10:30:00 AM#
X("Box" & T).Left = C * 1440

 

[MajP]

Not sure what you are saying. I would assume since you change C then the left position of the box would logically change. Why would you expect the box not to move.

Your code is very difficult to follow because it is not well written. You should strive to write code that can be easily followed and debugged.
This will help a lot. You fail to follow a lot of standard practices outlined here.

http://www.fmsinc.com/tpapers/vbacode/

Also use the TGML tags on the menu bar above where you type in the post, as I demonstrated in my post. Makes reading a lot easier.

 

[Andrzejek]

Just a guess here, but access101 may be saying:

[pre]
6:00 am -------
| | 6:15 am -------
| | | |
| | | |
| | | |
| | | |
| | | |
| | | |
| | | |
1:00 pm-------- 1:00 pm -------
[/pre]

If I am right - one for me as a mind reader

Have fun.

---- Andy

 

[access101]

yes Andrzejek that's exactly right. great mind reading skills!