We help IT Professionals succeed at work.

Update Cell with New Data if Data Overlap with Time

Billa7
Billa7 asked
on
325 Views
Last Modified: 2012-02-17
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

Open in new window

CrossCheck.xls
Comment
Watch Question

Most Valuable Expert 2012
Top Expert 2012
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Author

Commented:
Thanks Dave for the help
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.