Formula / VBA to help automate updating cell based on date/value

[terrib1e]

Here is a very simplified version of what I need help with. I'm trying to update dates people at my company put into our pto calendar in outlook in our availability spreadsheet.

On one worksheet I have a list of names in Column A and a list of dates across Row 1.

Name 1
Name 2
Name 3
Name 4
Name 5
Name 6
Name 7

<tbody>
[TD="class: xl65, width: 64, align: right"]1/1/2018[/TD]
[TD="class: xl65, width: 64, align: right"]1/2/2018[/TD]
[TD="class: xl65, width: 64, align: right"]1/3/2018[/TD]
[TD="class: xl65, width: 64, align: right"]1/4/2018[/TD]

[TD="class: xl66"][/TD]
[TD="class: xl66"][/TD]
[TD="class: xl66"][/TD]

[TD="class: xl66"][/TD]
[TD="class: xl66"][/TD]

</tbody>

In another sheet, I have a list of names and dates being pulled from an outlook calendar. I have a vba pull these appointments and insert them into a separate sheet. It looks similar to -

Name 1
Name 3

<tbody>
[TD="width: 64"]start[/TD]
[TD="width: 64"]end[/TD]

[TD="class: xl65, align: right"]1/2/2018[/TD]
[TD="class: xl65, align: right"]1/4/2018[/TD]

[TD="class: xl65, align: right"]1/1/2018[/TD]
[TD="class: xl65, align: right"]1/2/2018[/TD]

</tbody>

My end goal is to automatically match these and input a "0" in the first calendar. Ultimately i'd like it to look like -


[TABLE="width: 320"]
<tbody>[TR]
[TD="width: 64"][/TD]
[TD="class: xl65, width: 64, align: right"]1/1/2018[/TD]
[TD="class: xl65, width: 64, align: right"]1/2/2018[/TD]
[TD="class: xl65, width: 64, align: right"]1/3/2018[/TD]
[TD="class: xl65, width: 64, align: right"]1/4/2018[/TD]
[/TR]
[TR]
[TD]Name 1[/TD]
[TD][/TD]
[TD="class: xl66, align: right"]0%[/TD]
[TD="class: xl66, align: right"]0%[/TD]
[TD="class: xl66, align: right"]0%[/TD]
[/TR]
[TR]
[TD]Name 2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Name 3[/TD]
[TD="class: xl66, align: right"]0%[/TD]
[TD="class: xl66, align: right"]0%[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Name 4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Name 5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Name 6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Name 7[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Any help would be super appreciated. I'm trying to automate things as much as possible.

 

[crazydragon84]

how much vba do you know? can I just give you concepts? if so,

In your list that you have start and end - for each range in the list:
a) find Name in the Name list of original list and store the row number.
b) find the start date in the row 1 or original list and store the column number
c) do the same for end date.
d) Range(Cells(row_num,Start_Col),Cells(Row_Num,End_col)) = 0

 

[terrib1e]

Admittedly I'm still learning VBA and have really just become "Ok" at piecing various code together like legos. Your notes make sense and I appreciate your help. I'm slowly but surely working my way through each of them and seeing if i can put something together.

 

[mumps]

Try this macro:

Sub terrib1e()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim name As Range, foundName As Range
    Dim fDate As Range, lDate As Range
    For Each name In Sheets("Sheet2").Range("A2:A" & LastRow)
        Set foundName = Sheets("Sheet1").Range("A:A").Find(name, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundName Is Nothing Then
            Set fDate = Sheets("Sheet1").Rows(1).Find(name.Offset(0, 1))
            Set lDate = Sheets("Sheet1").Rows(1).Find(name.Offset(0, 2))
            Sheets("Sheet1").Range(Cells(foundName.Row, fDate.Column), Cells(foundName.Row, lDate.Column)) = 0
        End If
    Next name
    Application.ScreenUpdating = True
End Sub

Change the sheet names to suit your needs.

 

[crazydragon84]

Something like this should work. it assumes your data is in 2nd sheet and summary is in sheet 1 (and date in row 1 is in chronological order).

data sheet and summary sheet both has name in column A.

Sub give_it_a_try()




Dim Start_Date As Date, End_Date As Date, Name_Row As Single
Dim rng As Range, Last_Row As Single


'assume your data list is in second sheet
With Sheets(2)
    Last_Row = Range("A" & Rows.Count).End(xlUp).Row 'assumes your names are in column A
  
    For Each rng In .Range("A2:A" & Last_Row)
        Start_Date = rng.Offset(0, 1)
        End_Date = rng.Offset(0, 2)
        
        With Sheets(1)
            Name_Row = .Range("A:A").Find(what:=rng, LookIn:=xlValues, Lookat:=xlWhole).Row
            .Range(.Cells(Name_Row, .Rows("1:1").Find(what:=Start_Date, LookIn:=xlValues, Lookat:=xlWhole).Column), .Cells(Name_Row, .Rows("1:1").Find(what:=End_Date, LookIn:=xlValues, Lookat:=xlWhole).Column)) = 0
        End With
    Next rng
End With


End Sub

 

[crazydragon84]

oops mumps beat me to it. i think our codes are similar except he added the screen update for you to speed up the process

 

[terrib1e]

Thank you both for your help and HAPPY NEW YEAR! I'm able to get @mumps code working. The only issue I'm having is that it runs once, and unless I delete the cells that the 0's are placed in, it won't run again without an error. so if i added a name or added a diff date, it won't run it unless I delete everything and start fresh.

 

[mumps]

Try this version:

Sub terrib1e()
    Application.ScreenUpdating = False
    Dim LastRow1 As Long
    LastRow1 = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim LastRow2 As Long
    LastRow2 = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lCol As Long
    lCol = Sheets("Sheet1").UsedRange.Columns.Count
    Dim name As Range, foundName As Range
    Dim fDate As Range, lDate As Range
    Sheets("Sheet1").Range(Sheets("Sheet1").Cells(2, 2), Sheets("Sheet1").Cells(LastRow1, lCol)).ClearContents
    For Each name In Sheets("Sheet2").Range("A2:A" & LastRow2)
        Set foundName = Sheets("Sheet1").Range("A:A").Find(name, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundName Is Nothing Then
            Set fDate = Sheets("Sheet1").Rows(1).Find(name.Offset(0, 1))
            Set lDate = Sheets("Sheet1").Rows(1).Find(name.Offset(0, 2))
            Sheets("Sheet1").Range(Cells(foundName.Row, fDate.Column), Cells(foundName.Row, lDate.Column)) = 0
        End If
    Next name
    Application.ScreenUpdating = True
End Sub

 

[terrib1e]

The same issue occurs. So if I run the maco, and then go change an end date on the other sheet and run the macro again it gives me the '1004' error, but if I change the date and then click into the other sheet, it runs the macro without issue. I'm not sure why, but I have to go into a different sheet each time i change the date. The error is stemming from this line :

Sheets("Sheet1").Range(Cells(foundName.Row, fDate.Column), Cells(foundName.Row, lDate.Column)) = 0

 

[terrib1e]

I figured it out! The range wasn't fully qualified so it would only run from any sheet when I qualified it by making the range

Sheets("Sheet1").Range(Sheets("Sheet1").Cells(foundName.Row, fDate.Column), Sheets("Sheet1").Cells(foundName.Row, lDate.Column)) = 0