VBA Code to Formula code

laurentdes1984

New Member
Joined
Oct 21, 2019
Messages
2
Hi

Am trying to convert the attached VBA code to formula code because google sheet doesnt recognise the excel coding.

Can someone please asissit.

On insertion of the dates in Colunmn B, Column E, F, G, H and I automatically get populated Via VBA Code.

I would like an Excel Formula to inserted in the columns to replace the VBA code or an alternative for google sheet ( Please delete if am breaching the terms)

The Condition is : M-F 0600 - 1800 considers as Day , M-F 1800 - 0600 considers as Night, SAt and Sun are 24 hours

Thannks
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
You cant attach files on this forum.

Just copy the code and surround it within CODE tags, e.g.

[ code ]
[ /code ]

NOTE: Remove the spaces above when entering the tags - I had to enter the spaces or it wouldnt show up in this post.
 
Upvote 0
Code:
Function ShiftSplit(sd, st, et, Optional PH, Optional State)
Dim z(0 To 3), zz(0 To 3)
If Not (IsEmpty(sd) Or IsEmpty(st) Or IsEmpty(et)) Then
  ord = [{2.2708,2.7708;3.2708,3.7708;4.2708,4.7708;5.2708,5.7708;6.2708,6.7708}]
  night = [{2,2.2708;2.7708,3.2708;3.7708,4.2708;4.7708,5.2708;5.7708,6.2708;6.7708,7}]
  sat = [{0,1;7,8}]
  sun = [{1,2;8,9}]
  AllShifts = Array(ord, night, sat, sun)
  Fullsdt = CDbl(sd + st)
  Fulledt = CDbl(sd + et - (st >= et))
  sdt = Evaluate("mod(" & Fullsdt & ",7)")
  edt = Evaluate("mod(" & Fulledt & ",7)")
  If edt < sdt Then edt = edt + 7
  If Not IsMissing(PH) Then
    PHVals = PH.Value2
    sdLng = sd.Value2
    For i = 1 To UBound(PHVals)
      If sdLng = PHVals(i, 2) Then  'matching date
        If State = PHVals(i, 1) Then  'matching state
          PHsdt = sdLng
          PHedt = PHsdt + 1
          Exit For
        End If
      End If
    Next i
    'now check for day 2 if necessary:
    If Int(edt) > Int(sdt) Then  'it is necessary
      sdLng = sdLng + 1  'add 1 to startdate to test for second day being public holiday
      For i = 1 To UBound(PHVals)
        If sdLng = PHVals(i, 2) Then  'matching date
          If State = PHVals(i, 1) Then  'matching state
            If IsEmpty(PHsdt) Then PHsdt = sdLng
            PHedt = sdLng + 1
            Exit For
          End If
        End If
      Next i
    End If
    'now convert PH start/end to days of week
    PHsdt = Evaluate("mod(" & PHsdt & ",7)")
    PHedt = Evaluate("mod(" & PHedt & ",7)")
    If PHedt < PHsdt Then PHedt = PHedt + 7
  End If
  For j = LBound(AllShifts) To UBound(AllShifts)
    For i = LBound(AllShifts(j)) To UBound(AllShifts(j))
      ThisBlockStart = Application.Max(AllShifts(j)(i, 1), sdt)
      ThisBlockEnd = Application.Min(AllShifts(j)(i, 2), edt)
      temp = Application.Max(0, ThisBlockEnd - ThisBlockStart)
      If temp > 0 Then
        z(j) = z(j) + temp
        'check against public hols:
        PHBlockStart = Application.Max(PHsdt, ThisBlockStart)
        PHBlockEnd = Application.Min(PHedt, ThisBlockEnd)
        PHtemp = Application.Max(0, PHBlockEnd - PHBlockStart)
        If PHtemp > 0 Then
          zz(j) = zz(j) + PHtemp
        End If
      End If
    Next i
  Next j
End If
For i = LBound(z) To UBound(z)
  If z(i) = 0 Then z(i) = ""
  If zz(i) = 0 Then zz(i) = ""
Next i
If IsMissing(PH) Then ShiftSplit = z Else ShiftSplit = zz
End Function
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,016
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top