Populate Text from tracking sheet onto 3 different calendars sheets

[abressler]

New here! But I need some help automating data within an excel sheet. The attached sheet contains 5 tabs. First tab is a tracking sheet, second tab is a US calendar, third tab is a CA calendar, fourth tab is an AU calendar and the final tab is a list sheet for reference.
Using the tracking sheet tab. I'm trying to display column H text on the proper calendar (US, CA, AU tab) which is defined on column F. The Due Date in column D would then direct where column H text is displayed on that specific calendar.
For example. Line 2, column H text says "EMAIL Spring Sale 50% off all CUST" in bold. This needs to populate on the US calendar tab on 4/3/18 in the first available cell. In this case it would be cell i393 on the US calendar tab. If there is more than 1 event for a specific country on a given date then the text for the second event would populate on the line below for the specific day. The calendars allow for up to 5 events (5 rows for each date) to be populated.
Any help on creating this functionality would be awesome.... We all like challenges right?!?
Excel document can be found here.

https://www.dropbox.com/s/prfh28m8abjo767/FINAL%20Email%20Calendar%202018%20%281%29.xlsx?dl=0

 

[mumps]

Select the "Tracking" sheet to make it active, place the following macro in a regular module and run it from there.

Sub findDate()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Tracking").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ws As Worksheet
    Dim strdate As String
    Dim rDate As Range
    Dim foundDate As Range
    Dim fRow As Long
    For Each rDate In Sheets("Tracking").Range("D2:D" & LastRow)
        For Each ws In Sheets
            If ws.Name Like rDate.Offset(0, 2) & "*" Then
                strdate = CStr(rDate)
                Set foundDate = ws.UsedRange.Find(Format(rDate, "d-mmm"), LookIn:=xlValues, lookat:=xlWhole)
                If Not foundDate Is Nothing Then
                    fRow = ws.Range(ws.Cells(foundDate.Row, foundDate.Column), ws.Cells(foundDate.Row + 5, foundDate.Column)).Find(what:="").Row
                    ws.Cells(fRow, foundDate.Column) = rDate.Offset(0, 4)
                End If
            End If
        Next ws
    Next rDate
    Application.ScreenUpdating = True
End Sub

 

[abressler]

Thanks! This is an awesome MACRO. Is there a way for it to identify the proper country defined in column F so that content is placed on the proper calendar tab? Also want to keep the bolding texted as bolded when displaying on the calendar?

 

[mumps]

To take care of the bold text, replace this line of code:

ws.Cells(fRow, foundDate.Column) = rDate.Offset(0, 4)

to this:

rDate.Offset(0, 4).Copy ws.Cells(fRow, foundDate.Column)

The macro is already designed to identify the proper country defined in column F so that content is placed on the proper calendar tab. Is it not doing this for you?

 

[abressler]

You are correct. It does populate on the proper calendar and the code change to hold bolded text worked too. Cheers!

 

[mumps]

Glad it all worked out.

 

[abressler]

One last thing. This calendar will be updated. Currently whenever there is a change and re-run the macro it adds the previous events again to the specific calendar date. Is additional code to clear the calendars prior to running the macro?

 

[mumps]

Try:

Sub findDate()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Tracking").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ws As Worksheet
    Dim strdate As String
    Dim rDate As Range
    Dim foundDate As Range
    Dim fRow As Long
    Dim x As Long
    For Each ws In Sheets
        If ws.Name Like "*Calendar*" Then
            For x = 363 To 621 Step 6
                With ws.Range("E" & x & ":Q" & x + 4)
                    .ClearContents
                    .ClearFormats
                End With
            Next x
        End If
    Next ws
    For Each rDate In Sheets("Tracking").Range("D2:D" & LastRow)
        For Each ws In Sheets
            If ws.Name Like rDate.Offset(0, 2) & "*" Then
                strdate = CStr(rDate)
                Set foundDate = ws.UsedRange.Find(Format(rDate, "d-mmm"), LookIn:=xlValues, lookat:=xlWhole)
                If Not foundDate Is Nothing Then
                    fRow = ws.Range(ws.Cells(foundDate.Row, foundDate.Column), ws.Cells(foundDate.Row + 5, foundDate.Column)).Find(what:="").Row
                    rDate.Offset(0, 4).Copy ws.Cells(fRow, foundDate.Column)
                End If
            End If
        Next ws
    Next rDate
    Application.ScreenUpdating = True
End Sub

 

[abressler]

Hello -

I have updated this excel sheet. And trying to get the the above macro functionality with a different column structure in place.

Tracking Tab - Contains information needing to be placed in the calendar tabs on the correct date.
Column A has the country (US and CA)
Column R has the date
Column G has the text that needs to be displayed.

Column A determined the country calendar tab, Column R has the date in which that content needs to be placed on the specific calendar tab. Column G contains the text that needs to be placed.

Here is a link to the excel sheet
2020 Digital Workback Promo Schedule 2 (1).xlsm

Here is the macro code: Any help would be appreciated. Errors at the bottom on the fRow line.

Sub findDate()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("Tracking").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim ws As Worksheet
Dim strdate As String
Dim rDate As Range
Dim foundDate As Range
Dim fRow As Long
Dim x As Long
For Each ws In Sheets
If ws.Name Like "*Calendar*" Then
For x = 3 To 939 Step 6
With ws.Range("C" & x & ":I" & x + 4)
.ClearContents
.ClearFormats
End With
Next x
End If
Next ws
For Each rDate In Sheets("Tracking").Range("R2:R" & LastRow)
For Each ws In Sheets
If ws.Name Like rDate.Offset(17, 0) & "*" Then
strdate = CStr(rDate)
Set foundDate = ws.UsedRange.Find(Format(rDate, "d-mmm"), LookIn:=xlValues, lookat:=xlWhole)
If Not foundDate Is Nothing Then
fRow = ws.Range(ws.Cells(foundDate.Row, foundDate.Column), ws.Cells(foundDate.Row + 5, foundDate.Column)).Find(what:="").Row
rDate.Offset(11, 0).Copy ws.Cells(fRow, foundDate.Column)
End If
End If
Next ws
Next rDate
Application.ScreenUpdating = True
End Sub

 

[mumps]

You Had everything correct except for the column references. The "Offset" format is Offset(row, column) and the negative sign means an offset to the left of the date in column R. I hope that helps.

Sub findDate()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Tracking").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim ws As Worksheet
    Dim strdate As String
    Dim rDate As Range
    Dim foundDate As Range
    Dim fRow As Long
    Dim x As Long
    For Each ws In Sheets
        If ws.Name Like "*Calendar*" Then
            For x = 3 To 939 Step 6
                With ws.Range("C" & x & ":I" & x + 4)
                    .ClearContents
                    .ClearFormats
                End With
            Next x
        End If
    Next ws
    For Each rDate In Sheets("Tracking").Range("R2:R" & LastRow)
        For Each ws In Sheets
            If ws.Name Like rDate.Offset(0, -17) & "*" Then
                strdate = CStr(rDate)
                Set foundDate = ws.UsedRange.Find(Format(rDate, "d-mmm"), LookIn:=xlValues, lookat:=xlWhole)
                If Not foundDate Is Nothing Then
                    fRow = ws.Range(ws.Cells(foundDate.Row, foundDate.Column), ws.Cells(foundDate.Row + 5, foundDate.Column)).Find(what:="").Row
                    rDate.Offset(0, -11).Copy ws.Cells(fRow, foundDate.Column)
                End If
            End If
        Next ws
    Next rDate
    Application.ScreenUpdating = True
End Sub