troubleshooting Question

Update Cell with New Data if Data Overlap with Time

Avatar of Billa7
Billa7 asked on
Microsoft Excel
2 Comments1 Solution348 ViewsLast Modified:
I need Experts help  to add additional function in the attached script. Currently the script is used to update automatically data from Column B (Listing sheet) into Column G (Data sheet) if data at Column E cell (Data sheet) is matched with the data at Column A (Listing sheet).

The new function that need to add in this script is to prevent the same data from Column B (Listing sheet) being inserted on the same date at the Column G (Data sheet) if the timing  at Column D (Data sheet) has been clashed. If the data at Column G is clashed with other data within the same date, the next possible option to replace is by choosing a vacant (not being used on other cell within the same date) data from Listing sheet from range B5:B16.

e.g. Data at cell E4 and E5 are sharing the same data from Listing sheet "Title 14". Since the time (Column D) at cell D4 and D5 are clashed between 19:00 - 19:30, hence, cell D5 data need to be replaced with any available data from Range B5:B16.

Another Example is at Cell E9 and E10. Both Cells at Column G sharing the same Code whereby the timing have been clashed; between 21:00 - 22:15. Therefore Cell at G10 need to replaced with any vacant data from Range B5:B16 (Listing sheet).  Hope Experts able to add this function. Attached the workbook for Experts perusal.

Sub CopyCode()
Dim r As Range, Rng1 As Range, Rng2 As Range, rng3 As Range
Dim sFAddress As String, sCriteria As String

sCriteria = "Incoming ,Outgoing"  '<--Modify criteria as necessary

With Sheets("Listing")
    Set Rng1 = .Range(.Range("A2"), .Cells(Rows.Count, 1).End(xlUp))
End With
With Sheets("Data")
    Set Rng2 = .Range(.Range("E2"), .Cells(Rows.Count, 1).End(xlUp))
End With

For Each r In Rng1
    Set rng3 = Rng2.Find(r, Rng2.Cells(1), xlValues, xlPart)
    If Not rng3 Is Nothing Then
        sFAddress = rng3.Address
        Do
            If InStr(1, sCriteria, rng3.Offset(, 1)) <> 0 Then rng3.Offset(, 2) = r.Offset(, 1)
            Set rng3 = Rng2.FindNext(rng3)
        Loop While Not rng3 Is Nothing And rng3.Address <> sFAddress
    End If
Next r
End Sub
CrossCheck.xls
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 2 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 2 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros