Grab Zero's But Not Empty Cells

S

Snort

New Member
Joined
Sep 15, 2023
Messages
12
Office Version
  1. 365
Platform
  1. Windows
I wrote a VBA intended to take a sheet of multiple timeclock punches with duplicate dates of service and put them into a sheet with one row per date of service. I started with

VBA Code: 
        If TimeIn1 > 0 Then
            TI1.Add RecipDOS1(Z), TimeIn1
            TO1.Add RecipDOS1(Z), TimeOut1
        End If
        
        If TimeIn2 > 0 Then
            TI2.Add RecipDOS1(Z), TimeIn2
            TO2.Add RecipDOS1(Z), TimeOut2
        End If

But that missed shifts that started at Midnight. I then tried

VBA Code: 
         If Not IsEmpty(TimeIn1) Then
            TI1.Add RecipDOS1(Z), TimeIn1
            TO1.Add RecipDOS1(Z), TimeOut1
        End If
        
        If Not IsEmpty(TimeIn2) Then
            TI2.Add RecipDOS1(Z), TimeIn2
            TO2.Add RecipDOS1(Z), TimeOut2
        End If

But this grabs every empty cell, despite the immediate window returning TRUE when I input
VBA Code: 
debug.Print IsEmpty(ActiveCell)

How do I capture the shifts starting or ending at midnight, while NOT capturing the empty cells? The punch time for the midnight punches do have an actual value in the cell.

Here's the full code in case it helps



VBA Code: 
Sub One_Line_Per_Day_Recip()
'***This puts everything on one line per date of service.  Some edits will need to be made per project

Dim RecipDOS1 As New Scripting.Dictionary
Dim RecipDOS2 As New Scripting.Dictionary
Dim RecipDOS3 As New Scripting.Dictionary
Dim RecipDOS4 As New Scripting.Dictionary
Dim RecipDOS5 As New Scripting.Dictionary
Dim RecipDOS6 As New Scripting.Dictionary

RecipDOS1.CompareMode = TextCompare
RecipDOS2.CompareMode = TextCompare
RecipDOS3.CompareMode = TextCompare
RecipDOS4.CompareMode = TextCompare
RecipDOS5.CompareMode = TextCompare
RecipDOS6.CompareMode = TextCompare

Dim TI1 As New Scripting.Dictionary
Dim TI2 As New Scripting.Dictionary
Dim TI3 As New Scripting.Dictionary
Dim TI4 As New Scripting.Dictionary

Dim TO1 As New Scripting.Dictionary
Dim TO2 As New Scripting.Dictionary
Dim TO3 As New Scripting.Dictionary
Dim TO4 As New Scripting.Dictionary

Dim MFCUID As String
Dim MFCUIDCol As String
Dim RecipID As String
Dim RecipIDCol As String
Dim RecipName As String
Dim RecipNameCol As String
Dim DOS As String
Dim DOSCol As String
Dim Z As String

Dim TimeIn1 As Date
Dim TimeIn1Col As String

Dim TimeOut1 As Date
Dim TimeOut1Col As String

Dim TimeIn2 As Date
Dim TimeIn2Col As String

Dim TimeOut2 As Date
Dim TimeOut2Col As String

Dim TimeIn3 As Date
Dim TimeIn3Col As String

Dim TimeOut3 As Date
Dim TimeOut3Col As String

Dim TimeIn4 As Date
Dim TimeIn4Col As String

Dim TimeOut4 As Date
Dim TimeOut4Col As String

Dim cNum As Long

'***Last Row / Column*******
Dim Sht As Worksheet
Dim LastColumn As Long
Dim LastRow As Long
Dim X As Long

Sheets("Claims - Relevant Recips Only").Select
Set Sht = ActiveSheet

Range("A1").Select

LastRow = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row
LastColumn = Sht.Cells(1, Sht.Columns.Count).End(xlToLeft).Column

'***************************

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Do Until IsEmpty(ActiveCell)
    cNum = ActiveCell.Column
    
    If ActiveCell = "MFCU ID" Then
        MFCUIDCol = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Recipient ID" Then
        RecipIDCol = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Recipient Full Name" Or ActiveCell = "Recipient Name" Then
        RecipNameCol = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Date of Service" Then
        DOSCol = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Time In 1" Then
        TimeIn1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Time Out 1" Then
        TimeOut1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Time In 2" Then
        TimeIn2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Time Out 2" Then
        TimeOut2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Time In 3" Then
        TimeIn3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Time Out 3" Then
        TimeOut3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Time In 4" Then
        TimeIn4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Time Out 4" Then
        TimeOut4Col = Split(Cells(1, cNum).Address, "$")(1)
    End If
    
    ActiveCell(1, 2).Select
Loop

Range("A1").Select

'****************Putting Each Claim Line Into Dictionaries***********************
For X = 2 To LastRow

    MFCUID = Cells(X, MFCUIDCol)
    RecipID = Cells(X, RecipIDCol)
    RecipName = Cells(X, RecipNameCol)
    DOS = Cells(X, DOSCol)
    TimeIn1 = Cells(X, TimeIn1Col)
    TimeOut1 = Cells(X, TimeOut1Col)
    TimeIn2 = Cells(X, TimeIn2Col)
    TimeOut2 = Cells(X, TimeOut2Col)
    TimeIn3 = Cells(X, TimeIn3Col)
    TimeOut3 = Cells(X, TimeOut3Col)
    TimeIn4 = Cells(X, TimeIn4Col)
    TimeOut4 = Cells(X, TimeOut4Col)
    Z = RecipID & DOS
    
    If Not RecipDOS1.Exists(Z) Then
        RecipDOS1.Add Z, MFCUID
        If Not IsEmpty(TimeIn1) Then
            TI1.Add RecipDOS1(Z), TimeIn1
            TO1.Add RecipDOS1(Z), TimeOut1
        End If
        
        If Not IsEmpty(TimeIn2) Then
            TI2.Add RecipDOS1(Z), TimeIn2
            TO2.Add RecipDOS1(Z), TimeOut2
        End If
        
        If Not IsEmpty(TimeIn3) Then
            TI3.Add RecipDOS1(Z), TimeIn3
            TO3.Add RecipDOS1(Z), TimeOut3
        End If
        
        If Not IsEmpty(TimeIn4) Then
            TI4.Add RecipDOS1(Z), TimeIn4
            TO4.Add RecipDOS1(Z), TimeOut4
        End If
    ElseIf Not RecipDOS2.Exists(Z) Then
        RecipDOS2.Add Z, MFCUID
        If Not IsEmpty(TimeIn1) Then
            TI1.Add RecipDOS2(Z), TimeIn1
            TO1.Add RecipDOS2(Z), TimeOut1
        End If
        
        If Not IsEmpty(TimeIn2) Then
            TI2.Add RecipDOS2(Z), TimeIn2
            TO2.Add RecipDOS2(Z), TimeOut2
        End If
        
        If Not IsEmpty(TimeIn3) Then
            TI3.Add RecipDOS2(Z), TimeIn3
            TO3.Add RecipDOS2(Z), TimeOut3
        End If
        
        If Not IsEmpty(TimeIn4) Then
            TI4.Add RecipDOS2(Z), TimeIn4
            TO4.Add RecipDOS2(Z), TimeOut4
        End If
    ElseIf Not RecipDOS3.Exists(Z) Then
        RecipDOS3.Add Z, MFCUID
        If Not IsEmpty(TimeIn1) Then
            TI1.Add RecipDOS3(Z), TimeIn1
            TO1.Add RecipDOS3(Z), TimeOut1
        End If
        
        If Not IsEmpty(TimeIn2) Then
            TI2.Add RecipDOS3(Z), TimeIn2
            TO2.Add RecipDOS3(Z), TimeOut2
        End If
        
        If Not IsEmpty(TimeIn3) Then
            TI3.Add RecipDOS3(Z), TimeIn3
            TO3.Add RecipDOS3(Z), TimeOut3
        End If
        
        If Not IsEmpty(TimeIn4) Then
            TI4.Add RecipDOS3(Z), TimeIn4
            TO4.Add RecipDOS3(Z), TimeOut4
        End If
    ElseIf Not RecipDOS4.Exists(Z) Then
        RecipDOS4.Add Z, MFCUID
        If Not IsEmpty(TimeIn1) Then
            TI1.Add RecipDOS4(Z), TimeIn1
            TO1.Add RecipDOS4(Z), TimeOut1
        End If
        
        If Not IsEmpty(TimeIn2) Then
            TI2.Add RecipDOS4(Z), TimeIn2
            TO2.Add RecipDOS4(Z), TimeOut2
        End If
        
        If Not IsEmpty(TimeIn3) Then
            TI3.Add RecipDOS4(Z), TimeIn3
            TO3.Add RecipDOS4(Z), TimeOut3
        End If
        
        If Not IsEmpty(TimeIn4) Then
            TI4.Add RecipDOS4(Z), TimeIn4
            TO4.Add RecipDOS4(Z), TimeOut4
        End If
    ElseIf Not RecipDOS5.Exists(Z) Then
        RecipDOS5.Add Z, MFCUID
        If Not IsEmpty(TimeIn1) Then
            TI1.Add RecipDOS5(Z), TimeIn1
            TO1.Add RecipDOS5(Z), TimeOut1
        End If
        
        If Not IsEmpty(TimeIn2) Then
            TI2.Add RecipDOS5(Z), TimeIn2
            TO2.Add RecipDOS5(Z), TimeOut2
        End If
        
        If Not IsEmpty(TimeIn3) Then
            TI3.Add RecipDOS5(Z), TimeIn3
            TO3.Add RecipDOS5(Z), TimeOut3
        End If
        
        If Not IsEmpty(TimeIn4) Then
            TI4.Add RecipDOS5(Z), TimeIn4
            TO4.Add RecipDOS5(Z), TimeOut4
        End If
    ElseIf Not RecipDOS6.Exists(Z) Then
        RecipDOS6.Add Z, MFCUID
        If Not IsEmpty(TimeIn1) Then
            TI1.Add RecipDOS6(Z), TimeIn1
            TO1.Add RecipDOS6(Z), TimeOut1
        End If
        
        If Not IsEmpty(TimeIn2) Then
            TI2.Add RecipDOS6(Z), TimeIn2
            TO2.Add RecipDOS6(Z), TimeOut2
        End If
        
        If Not IsEmpty(TimeIn3) Then
            TI3.Add RecipDOS6(Z), TimeIn3
            TO3.Add RecipDOS6(Z), TimeOut3
        End If
        
        If Not IsEmpty(TimeIn4) Then
            TI4.Add RecipDOS6(Z), TimeIn4
            TO4.Add RecipDOS6(Z), TimeOut4
        End If
    Else
        MsgBox "Need more dictionaries for " & RecipID & " at row " & X
        Exit Sub
    End If
    
Next X

'**************Putting onto one line per date of service**********************

'***Last Row / Column*******
Sheets("One Line Per Date").Select
Set Sht = ActiveSheet

Range("A1").Select

LastRow = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row
LastColumn = Sht.Cells(1, Sht.Columns.Count).End(xlToLeft).Column

'***************************

'***REDACTED****
Dim CHIn1Col As String
Dim CHOut1Col As String
Dim CHIn2Col As String
Dim CHOut2Col As String
Dim CHIn3Col As String
Dim CHOut3Col As String
Dim CHIn4Col As String
Dim CHOut4Col As String
Dim CHMFCUID1Col As String
Dim CHMFCUID2Col As String
Dim CHMFCUID3Col As String
Dim CHMFCUID4Col As String

'***REDACTED****
Dim JCIn1Col As String
Dim JCOut1Col As String
Dim JCIn2Col As String
Dim JCOut2Col As String
Dim JCIn3Col As String
Dim JCOut3Col As String
Dim JCIn4Col As String
Dim JCOut4Col As String
Dim JCMFCUID1Col As String
Dim JCMFCUID2Col As String
Dim JCMFCUID3Col As String
Dim JCMFCUID4Col As String

'***REDACTED****
Dim MSIn1Col As String
Dim MSOut1Col As String
Dim MSIn2Col As String
Dim MSOut2Col As String
Dim MSIn3Col As String
Dim MSOut3Col As String
Dim MSIn4Col As String
Dim MSOut4Col As String
Dim MSMFCUID1Col As String
Dim MSMFCUID2Col As String
Dim MSMFCUID3Col As String
Dim MSMFCUID4Col As String

'***REDACTED****
Dim NSIn1Col As String
Dim NSOut1Col As String
Dim NSIn2Col As String
Dim NSOut2Col As String
Dim NSIn3Col As String
Dim NSOut3Col As String
Dim NSIn4Col As String
Dim NSOut4Col As String
Dim NSMFCUID1Col As String
Dim NSMFCUID2Col As String
Dim NSMFCUID3Col As String
Dim NSMFCUID4Col As String

Do Until IsEmpty(ActiveCell)

    cNum = ActiveCell.Column
    
    If ActiveCell = "REDACTED 1 MFCU ID" Then
        CHMFCUID1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 2 MFCU ID" Then
        CHMFCUID2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 3 MFCU ID" Then
        CHMFCUID3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 4 MFCU ID" Then
        CHMFCUID4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 1" Then
        CHIn1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 1" Then
        CHOut1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 2" Then
        CHIn2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 2" Then
        CHOut2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 3" Then
        CHIn3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 3" Then
        CHOut3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 4" Then
        CHIn4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 4" Then
        CHOut4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED MFCU ID" Then
        JCMFCUID1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 2 MFCU ID" Then
        JCMFCUID2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 3 MFCU ID" Then
        JCMFCUID3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 4 MFCU ID" Then
        JCMFCUID4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 1" Then
        JCIn1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 1" Then
        JCOut1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 2" Then
        JCIn2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 2" Then
        JCOut2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 3" Then
        JCIn3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 3" Then
        JCOut3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 4" Then
        JCIn4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 4" Then
        JCOut4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 1 MFCU ID" Then
        MSMFCUID1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 2 MFCU ID" Then
        MSMFCUID2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 3 MFCU ID" Then
        MSMFCUID3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 4 MFCU ID" Then
        MSMFCUID4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 1" Then
        MSIn1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 1" Then
        MSOut1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 2" Then
        MSIn2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 2" Then
        MSOut2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 3" Then
        MSIn3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 3" Then
        MSOut3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 4" Then
        MSIn4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 4" Then
        MSOut4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 1 MFCU ID" Then
        NSMFCUID1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 2 MFCU ID" Then
        NSMFCUID2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 3 MFCU ID" Then
        NSMFCUID3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED 4 MFCU ID" Then
        NSMFCUID4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 1" Then
        NSIn1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 1" Then
        NSOut1Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 2" Then
        NSIn2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 2" Then
        NSOut2Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 3" Then
        NSIn3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 3" Then
        NSOut3Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED In 4" Then
        NSIn4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "REDACTED Out 4" Then
        NSOut4Col = Split(Cells(1, cNum).Address, "$")(1)
    ElseIf ActiveCell = "Date of Service" Then
        DOSCol = Split(Cells(1, cNum).Address, "$")(1)
    End If
    
    ActiveCell(1, 2).Select
Loop

Range("A1").Select

For X = 2 To LastRow
    
    DOS = Cells(X, DOSCol)
    
'***REDACTED***
'***REMEMBER TO CHANGE THE INITIALS WHEN CHANGING THE RECIP ID!!
'    RecipID = "REDACTED"

    
'**********REDACTED***************
'***REMEMBER TO CHANGE THE INITIALS WHEN CHANGING THE RECIP ID!!
'    RecipID = "REDACTED"
    
'*********REDACTED**************
'***REMEMBER TO CHANGE THE INITIALS WHEN CHANGING THE RECIP ID!!
'    RecipID = "REDACTED"

'*******REDACTED*************************
'***REMEMBER TO CHANGE THE INITIALS WHEN CHANGING THE RECIP ID!!
    RecipID = "REDACTED"

    Z = RecipID & DOS
    
    If RecipDOS1.Exists(Z) Then
        If TI1.Exists(RecipDOS1(Z)) Then
            Cells(X, NSIn1Col).Value = TI1(RecipDOS1(Z))
            Cells(X, NSOut1Col).Value = TO1(RecipDOS1(Z))
            Cells(X, NSMFCUID1Col).Value = RecipDOS1(Z)
        End If
        
        If TI2.Exists(RecipDOS1(Z)) Then
            Cells(X, NSIn2Col).Value = TI2(RecipDOS1(Z))
            Cells(X, NSOut2Col).Value = TO2(RecipDOS1(Z))
            Cells(X, NSMFCUID2Col).Value = RecipDOS1(Z)
        End If
        
        If TI3.Exists(RecipDOS1(Z)) Then
            Cells(X, NSIn3Col).Value = TI3(RecipDOS1(Z))
            Cells(X, NSOut3Col).Value = TO3(RecipDOS1(Z))
            Cells(X, NSMFCUID3Col).Value = RecipDOS1(Z)
        End If
        
        If TI4.Exists(RecipDOS1(Z)) Then
            Cells(X, NSIn4Col).Value = TI4(RecipDOS1(Z))
            Cells(X, NSOut4Col).Value = TO4(RecipDOS1(Z))
            Cells(X, NSMFCUID4Col).Value = RecipDOS1(Z)
        End If
        
        RecipDOS1.Remove Z
    End If
    
    If RecipDOS2.Exists(Z) Then
        If TI1.Exists(RecipDOS2(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI1(RecipDOS2(Z))
                Cells(X, NSOut1Col).Value = TO1(RecipDOS2(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI1(RecipDOS2(Z))
                Cells(X, NSOut2Col).Value = TO1(RecipDOS2(Z))
                Cells(X, NSMFCUID2Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI1(RecipDOS2(Z))
                Cells(X, NSOut3Col).Value = TO1(RecipDOS2(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI1(RecipDOS2(Z))
                Cells(X, NSOut4Col).Value = TO1(RecipDOS2(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS2(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        If TI2.Exists(RecipDOS2(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI2(RecipDOS2(Z))
                Cells(X, NSOut1Col).Value = TO2(RecipDOS2(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI2(RecipDOS2(Z))
                Cells(X, NSOut2Col).Value = TO2(RecipDOS2(Z))
                Cells(X, NSMFCUID2Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI2(RecipDOS2(Z))
                Cells(X, NSOut3Col).Value = TO2(RecipDOS2(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI2(RecipDOS2(Z))
                Cells(X, NSOut4Col).Value = TO2(RecipDOS2(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS2(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        If TI3.Exists(RecipDOS2(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI3(RecipDOS2(Z))
                Cells(X, NSOut1Col).Value = TO3(RecipDOS2(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI3(RecipDOS2(Z))
                Cells(X, NSOut2Col).Value = TO3(RecipDOS2(Z))
                Cells(X, NSMFCUID2Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI3(RecipDOS2(Z))
                Cells(X, NSOut3Col).Value = TO3(RecipDOS2(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI3(RecipDOS2(Z))
                Cells(X, NSOut4Col).Value = TO3(RecipDOS2(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS2(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        If TI4.Exists(RecipDOS2(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI4(RecipDOS2(Z))
                Cells(X, NSOut1Col).Value = TO4(RecipDOS2(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI4(RecipDOS2(Z))
                Cells(X, NSOut2Col).Value = TO4(RecipDOS2(Z))
                Cells(X, NSMFCUID2Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI4(RecipDOS2(Z))
                Cells(X, NSOut3Col).Value = TO4(RecipDOS2(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS2(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI4(RecipDOS2(Z))
                Cells(X, NSOut4Col).Value = TO4(RecipDOS2(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS2(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        RecipDOS2.Remove Z
    End If
    
    If RecipDOS3.Exists(Z) Then
        If TI1.Exists(RecipDOS3(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI1(RecipDOS3(Z))
                Cells(X, NSOut1Col).Value = TO1(RecipDOS3(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI1(RecipDOS3(Z))
                Cells(X, NSOut2Col).Value = TO1(RecipDOS3(Z))
                Cells(X, NSMFCUID2Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI1(RecipDOS3(Z))
                Cells(X, NSOut3Col).Value = TO1(RecipDOS3(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI1(RecipDOS3(Z))
                Cells(X, NSOut4Col).Value = TO1(RecipDOS3(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS3(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        If TI2.Exists(RecipDOS3(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI2(RecipDOS3(Z))
                Cells(X, NSOut1Col).Value = TO2(RecipDOS3(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI2(RecipDOS3(Z))
                Cells(X, NSOut2Col).Value = TO2(RecipDOS3(Z))
                Cells(X, NSMFCUID2Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI2(RecipDOS3(Z))
                Cells(X, NSOut3Col).Value = TO2(RecipDOS3(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI2(RecipDOS3(Z))
                Cells(X, NSOut4Col).Value = TO2(RecipDOS3(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS3(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        If TI3.Exists(RecipDOS3(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI3(RecipDOS3(Z))
                Cells(X, NSOut1Col).Value = TO3(RecipDOS3(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI3(RecipDOS3(Z))
                Cells(X, NSOut2Col).Value = TO3(RecipDOS3(Z))
                Cells(X, NSMFCUID2Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI3(RecipDOS3(Z))
                Cells(X, NSOut3Col).Value = TO3(RecipDOS3(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI3(RecipDOS3(Z))
                Cells(X, NSOut4Col).Value = TO3(RecipDOS3(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS3(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        If TI4.Exists(RecipDOS3(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI4(RecipDOS3(Z))
                Cells(X, NSOut1Col).Value = TO4(RecipDOS3(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI4(RecipDOS3(Z))
                Cells(X, NSOut2Col).Value = TO4(RecipDOS3(Z))
                Cells(X, NSMFCUID2Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI4(RecipDOS3(Z))
                Cells(X, NSOut3Col).Value = TO4(RecipDOS3(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS3(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI4(RecipDOS3(Z))
                Cells(X, NSOut4Col).Value = TO4(RecipDOS3(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS3(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        RecipDOS3.Remove Z
    End If
    
    If RecipDOS4.Exists(Z) Then
        If TI1.Exists(RecipDOS4(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI1(RecipDOS4(Z))
                Cells(X, NSOut1Col).Value = TO1(RecipDOS4(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI1(RecipDOS4(Z))
                Cells(X, NSOut2Col).Value = TO1(RecipDOS4(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI1(RecipDOS4(Z))
                Cells(X, NSOut3Col).Value = TO1(RecipDOS4(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI1(RecipDOS4(Z))
                Cells(X, NSOut4Col).Value = TO1(RecipDOS4(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS4(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        If TI2.Exists(RecipDOS4(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI2(RecipDOS4(Z))
                Cells(X, NSOut1Col).Value = TO2(RecipDOS4(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI2(RecipDOS4(Z))
                Cells(X, NSOut2Col).Value = TO2(RecipDOS4(Z))
                Cells(X, NSMFCUID2Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI2(RecipDOS4(Z))
                Cells(X, NSOut3Col).Value = TO2(RecipDOS4(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI2(RecipDOS4(Z))
                Cells(X, NSOut4Col).Value = TO2(RecipDOS4(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS4(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        If TI3.Exists(RecipDOS4(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI3(RecipDOS4(Z))
                Cells(X, NSOut1Col).Value = TO3(RecipDOS4(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI3(RecipDOS4(Z))
                Cells(X, NSOut2Col).Value = TO3(RecipDOS4(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI3(RecipDOS4(Z))
                Cells(X, NSOut3Col).Value = TO3(RecipDOS4(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI3(RecipDOS4(Z))
                Cells(X, NSOut4Col).Value = TO3(RecipDOS4(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS4(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        If TI4.Exists(RecipDOS4(Z)) Then
            If IsEmpty(Cells(X, NSIn1Col)) Then
                Cells(X, NSIn1Col).Value = TI4(RecipDOS4(Z))
                Cells(X, NSOut1Col).Value = TO4(RecipDOS4(Z))
                Cells(X, NSMFCUID1Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn2Col)) Then
                Cells(X, NSIn2Col).Value = TI4(RecipDOS4(Z))
                Cells(X, NSOut2Col).Value = TO4(RecipDOS4(Z))
                Cells(X, NSMFCUID2Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn3Col)) Then
                Cells(X, NSIn3Col).Value = TI4(RecipDOS4(Z))
                Cells(X, NSOut3Col).Value = TO4(RecipDOS4(Z))
                Cells(X, NSMFCUID3Col).Value = RecipDOS4(Z)
            ElseIf IsEmpty(Cells(X, NSIn4Col)) Then
                Cells(X, NSIn4Col).Value = TI4(RecipDOS4(Z))
                Cells(X, NSOut4Col).Value = TO4(RecipDOS4(Z))
                Cells(X, NSMFCUID4Col).Value = RecipDOS4(Z)
            Else
                MsgBox "Need more time slots for REDACTED - row " & X
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
        
        RecipDOS4.Remove Z

    End If
    
Next X

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "VBA Done"


End Sub
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
Try changing it to:
VBA Code: 
If TimeIn1<>"" Then

If this doesn't work, what does the program show for the value of TimeIn1 when the cell is blank?
 
Upvote 0
Solution
Brilliant! I had to change the type of the TimeIn's and TimeOut's from Date to String, but it worked!

Thanks @NateSC
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Using VBA to Flag and Calculate Overlapping Shift Times
Replies
0
Views
464
Snort
S
H
  • Solved
Amend the VBA code to Filter Columns Instead of Rows
Replies
9
Views
613
Akuini
Akuini
ChristineJ
  • Question Question
Function rather than macro to return cell references
Replies
3
Views
346
Micron
M
ChristineJ
  • Solved
Adapting code to return cell values rather than cell references
Replies
2
Views
378
ChristineJ
ChristineJ
D
  • Solved
Numeric Value returned when Time format returned to User Form TextBox
Replies
3
Views
79
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,223,903
Messages
6,175,286
Members
452,631
Latest member
a_potato

Share this page

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