Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all articles
Browse latest Browse all 49948

Copy data based on datevalue

$
0
0
Hi I am trying to copy movie title from one sheet to another.
SCHEDULE is where I want the titles to show up and the movie should be the upcoming weekend movie. The movie comes from the MOVIES sheet.
On the SCHEDULE sheet I have column P that has random values of MOVIE and only in the Column Q, R, S, T I paste movie info.
I have one day working, but I want to rotate the Friday 21:00 movie or two movies on Saturday 18:30 and 21:00 or Sunday 21:00. I cannot seem to get the rotation going.
I have attached a file of the code and sheets, the code is on the MASTERCONTROL sheet Macro 1
Here is the code, and I think the way I am deciding which day of week to find friday etc is overdone.
Thanks
Dale
Code:

Sub Macro1()

 
 
  Dim dayWeekN As Variant
 
 
    ' GREATER THAN 1 HOUR
    'MOVIES
    'assign movie if LESS than 18:00
 With ActiveSheet
  '**********************SATURDAY****************************************************
  MPROM = Sheets("MOVIES").Cells(.Rows.Count, "L").End(xlUp).Row
  LR = Sheets("SCHEDULE").Cells(.Rows.Count, "L").End(xlUp).Row
    For a = 1 To 1000
 
    For m = 2 To MPROM
 
 If Sheets("SCHEDULE").Range("P" & a).Text = "MOVIE" Then
      If Weekday(Sheets("SCHEDULE").Range("C" & a).Value) = 2 Then
    dayWeekN0 = 4
    dayWeekN1 = 5
      dayWeekN2 = 6
    ' rdn = 1
End If
 If Weekday(Sheets("SCHEDULE").Range("C" & a).Value) = 3 Then
    dayWeekN0 = 3
    dayWeekN1 = 4
      dayWeekN2 = 5
    ' rdn = 1
End If
 If Weekday(Sheets("SCHEDULE").Range("C" & a).Value) = 4 Then
    dayWeekN0 = 2
    dayWeekN1 = 3
      dayWeekN2 = 4
    ' rdn = 1
End If
 If Weekday(Sheets("SCHEDULE").Range("C" & a).Value) = 5 Then
    dayWeekN0 = 1
    dayWeekN1 = 2
      dayWeekN2 = 3
    ' rdn = 1
End If

 If Weekday(Sheets("SCHEDULE").Range("C" & a).Value) = 6 Then
    dayWeekN0 = 0
    dayWeekN1 = 1
      dayWeekN2 = 2
End If

 If Weekday(Sheets("SCHEDULE").Range("C" & a).Value) = 7 Then
    dayWeekN0 = 6
    dayWeekN1 = 0
      dayWeekN2 = 1
      'rdn = 2
End If

 If Weekday(Sheets("SCHEDULE").Range("C" & a).Value) = 1 Then
If TimeValue(Sheets("SCHEDULE").Range("C" & a).Value) < TimeValue("21:00") Then

    dayWeekN0 = 5
    dayWeekN1 = 6
      dayWeekN2 = 0
      End If
      If TimeValue(Sheets("SCHEDULE").Range("C" & a).Value) >= TimeValue("21:00") Then
      dayWeekN0 = 5
    dayWeekN1 = 6
      dayWeekN2 = 7
      End If
End If
         

 
    If DateValue(Sheets("MOVIES").Range("J" & m)) - (dayWeekN1) = DateValue(Sheets("SCHEDULE").Range("J" & a)) Then
 
   
            If (Sheets("MOVIES").Range("L" & m).Text) = "18:30" Or (Sheets("MOVIES").Range("L" & m).Text) = "19:00" And Weekday(Sheets("MOVIES").Range("J" & m).Text) = 7 Then
 

     
              Sheets("SCHEDULE").Range("Q" & a).Value = Sheets("MOVIES").Range("B" & m).Text
              Sheets("SCHEDULE").Range("R" & a).Value = Sheets("MOVIES").Range("J" & m).Text & " " & Sheets("MOVIES").Range("L" & m).Text
           
            End If
           
          For mm = m To MPROM
           
         
            If Sheets("MOVIES").Range("L" & m).Text = "21:00" And Weekday(Sheets("MOVIES").Range("J" & m).Text) = 7 Then
 
              Sheets("SCHEDULE").Range("S" & a).Value = Sheets("MOVIES").Range("B" & m).Text
              Sheets("SCHEDULE").Range("T" & a).Value = Sheets("MOVIES").Range("J" & m).Text & " " & Sheets("MOVIES").Range("L" & m).Text
           
                m = m + 1
            End If
   
         
          Next
     
    End If
       
  '  End If
   
      ' Sheets("TTESCHEDULE").Range("P" & a).Value = "MOVIE"
        Sheets("SCHEDULE").Range("W" & a).Value = ""
              Sheets("SCHEDULE").Range("X" & a).Value = ""
                 
        'End If
       
  End If
   
   
  ' End If
 
  Next
  'a = a + 2
Next
End With
End Sub

Attached Files

Viewing all articles
Browse latest Browse all 49948

Trending Articles