Parenting Calendar in excel exported to CSV for import into google calendar

[sly020175]

Hi everyone,
I have what seems like it should be a simple task, but have been searching for hours and can't find something similar to what I am trying to do.
VBA exp = newbie
Excel = Office 13

I already have a calendar setup in a "Calendar" view that shows what day the kids are with either mom or dad based on color. The colors were done with a combination of conditional formatting and manual entry. I was trying to change that "Calendar" view and change it to a "List" view with the column headers below. The Calendar is setup to automatically update based on the year (i.e. depending on what year the dates will move around and not be in a fixed position). I am trying to do a VBA that will use the Calendar view and transfer the date to the Start Date and then depending on the cell color will put Mom or Dad in the Subject field. I believe the color index for mom = -4141 and dad = 43. I have attached a pic of my excel calendar as reference. It seems like this should be easy, but I have not been able to figure it out. If it is much more complex than I am thinking then just let me know and I will just manually enter the dates into google calendar Thanks in advance for any help / guidance.


Subject Start Date Start Time End Date End Time All Day Event Description Location Private
Mom 1/1/2020
Mom 1/2/2020
Dad 1/3/2020
Dad 1/4/2020
Dad 1/5/2020
Mom 1/6/2020
.
.
.
.
ect.

[Paul_Hossler]

A sample workbook would be more useful than a screen shot

[sly020175]

A sample workbook would be more useful than a screen shot

I have attached the workbook I am working in. Thanks for looking.

[Paul_Hossler]

Maybe something like this

Calendar locations are hard coded from your input sheet

It's easy enough to add a CSV export feature to save the CSV sheet as a separate file, but since this looked like a once a year thing, you can also do it manually

Option Explicit


Sub ExportToGoogleCalendar()
    Dim iMonthCol As Long, iMonthRow As Long, iWeek As Long, iDay As Long
    Dim iOut As Long
    
    Dim wsCal As Worksheet, wsCSV As Worksheet
    
    'setup
    Application.ScreenUpdating = False
    
    Set wsCal = Worksheets("2020 Calendar") '   could be Activesheet
    
    'add new CSV sheet
    Application.DisplayAlerts = False
    On Error Resume Next
    Worksheets("CSV").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    Worksheets.Add.Name = "CSV"
    Set wsCSV = Worksheets("CSV")
    
    'put headers on CSV sheet
    iOut = 1
    wsCSV.Cells(iOut, 1).Resize(1, 9).Value = Array("Subject", "Start Date", "Start Time", "End Date", "End Time", "All Day Event", "Description", "Location", "Private")
    iOut = iOut + 1
    
    
    'make the list
    With wsCal
        For iMonthRow = 3 To 30 Step 9
            For iMonthCol = 2 To 18 Step 8
                For iWeek = iMonthRow + 2 To iMonthRow + 7
                    For iDay = iMonthCol To iMonthCol + 7
                        If Len(.Cells(iWeek, iDay).Value) > 0 Then
                            If .Cells(iWeek, iDay).Interior.Color = 5296274 Then
                                wsCSV.Cells(iOut, 1).Value = "Dad"
                            ElseIf .Cells(iWeek, iDay).Interior.Color = 16777215 Then   '   colors are inconsistent
                                wsCSV.Cells(iOut, 1).Value = "Mom"
                            ElseIf .Cells(iWeek, iDay).Interior.Color = 15773696 Then
                                wsCSV.Cells(iOut, 1).Value = "Mom"
                            End If
                            wsCSV.Cells(iOut, 2).Value = .Cells(iWeek, iDay).Value
                            wsCSV.Cells(iOut, 4).Value = .Cells(iWeek, iDay).Value
                            wsCSV.Cells(iOut, 6).Value = True
                            wsCSV.Cells(iOut, 9).Value = True
                            
                            iOut = iOut + 1
                        End If
                    Next iDay
                Next iWeek
            Next iMonthCol
        Next iMonthRow
    End With
    
    
    'cleanup
    wsCSV.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
    Application.ScreenUpdating = True
    
    
    MsgBox "Done"
    
End Sub

[sly020175]

Thanks Paul!!! That was 99% perfect. The only part that was not working was the conditional formatting cells. The cells with conditional formatting always defaulted to Mom even if they were really Dad cells. After doing some research I found that is all I needed to do was replace the lines you had with .Interior.Color with .DisplayFormat.Interior.Color. I don't fully understand why, but that seemed to fix it and it now works perfect

I was trying to read about For Step To functions you used and not sure I fully understand how those work either. I can kind of understand that it is looking at certain parts of the row/columns, but not sure exactly how it works. Could you explain that function a little more for my own learning? If not, it's ok I will keep reading trying to learn.

Thank you so much again!!!

[Paul_Hossler]

all I needed to do was replace the lines you had with .Interior.Color with .DisplayFormat.Interior.Color. I don't fully understand why, but that seemed to fix it and it now works perfect

1. Good

2. Good tutorial here

https://docs.microsoft.com/en-us/off...next-statement

The challenge was starting at the correct position for each of the 12 blocks (3 by 4), and then figuring out where to start within each of the 12 month blocks

[Lilybets]

Thanks for sharing the solution. It helped me greatly. But, you know, I’ve already had so many problems with those online calendars that I’m so sick and tired of it. So, these days I tried the printed calendar https://www.123calendars.com/2023-calendar.html for the first time recently. And I actually find it really comfy to organize my work. You see, when you write down your tasks for a day, your brain overthinks them twice. So, I think a printed calendar is crucial for planning nowadays. What do you think?