Solved: LOOPING through a date range?

[emm]

For just one row:

Setup:

Range A2 houses a name
Range B2:C2 houses a start and end date formatted dd mmm yy
Range D1:AH1 houses days of a month custom formatted to "d"

Anytime data is changed in Range A2:C2, I want to put the day of the month from Range D1:AH1 in range D2:AH2 when they match or are between dates in B2:C2 This would be a Gantt Chart but with dates unstead of shading...

I am familar with Private Sub Worksheet_Change(ByVal Target As Range) but can not figure out how to do this loop.

[acw]

Hi

This will put in the full date and format to the day in the same way that row 1 is formatted.

[VBA]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column < 4 Then
Range("D" & Target.Row & ":AH" & Target.Row).ClearContents
Range(Cells(Target.Row, 3 + Day(Cells(Target.Row, 2))), Cells(Target.Row, 3 + Day(Cells(Target.Row, 3)))).Value = _
Range(Cells(1, 3 + Day(Cells(Target.Row, 2))), Cells(1, 3 + Day(Cells(Target.Row, 3)))).Value
Range(Cells(Target.Row, 3 + Day(Cells(Target.Row, 2))), Cells(Target.Row, 3 + Day(Cells(Target.Row, 3)))).NumberFormat = _
Range(Cells(1, 3 + Day(Cells(Target.Row, 2))), Cells(1, 3 + Day(Cells(Target.Row, 3)))).NumberFormat
End If
End Sub
[/VBA]

Tony

[acw]

Hi

Another options with only numbers
[VBA]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column < 4 Then
Range("D" & Target.Row & ":AH" & Target.Row).ClearContents
For i = Day(Cells(Target.Row, 2)) + 3 To Day(Cells(Target.Row, 3)) + 3
Cells(Target.Row, i).Value = i - 3
Next i
End If
End Sub
[/VBA]


Tony

[emm]

ACW - thanks a bunch, couple to questions:

1. When I click any cell in the target range and don't put a date the last day of the month shows up under the last day of the month.
-- That might be OK, will have to work with it a few days.

2. When I put a date in columns B and C the date goes from "start" (column B) date to last day of the month until I put a name in column A then the date works itself out?
-- That might be OK, will have to work with it a few days.

3. What I'm trying to do is make a Gantt Chart where I can show tasks that each office is suppose to do by date. I will add another column for that later.

Here is some code that Erik Van Geit helped me and yours added:

- It colors range A:C based on the office name in column A.
- I want to use that same office color where your code puts the date.
- I use condition formatting to color the weekends, this might cause a problem?

[VBA] Option Explicit
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Erik Van Geit
'051116
Dim WatchRange As Range
Dim cell As Range
Dim colors As Variant
Dim i As Integer
Dim inputs As Variant
Dim col As Integer
Set WatchRange = Range("A2:AM" & Rows.Count)
If Intersect(Target, WatchRange) Is Nothing Then Exit Sub
'ACW starts here
If Target.Column < 4 Then
Range("D" & Target.Row & ":AH" & Target.Row).ClearContents
For i = Day(Cells(Target.Row, 2)) + 3 To Day(Cells(Target.Row, 3)) + 3
Cells(Target.Row, i).Value = i - 3
Next i
End If
'ACW ends here
Range("D" & Target.Row & ":AH" & Target.Row).Interior.ColorIndex = 0
inputs = Array("Office A", "Office B", "Office C", "Office D", "Office E", "Office F")
colors = Array(3, 4, 5, 6, 7, 8)

For Each cell In Target
i = 0
On Error Resume Next
i = Application.Match(cell.Value, inputs, 0)
On Error GoTo 0
If i <> 0 Then col = colors(i) Else: col = xlNone
cell.Interior.ColorIndex = col
Intersect(cell.EntireRow, Columns("A:C")).Interior.ColorIndex = col
Next cell

End Sub
[/VBA]

[emm]

acw - which "line of code" line is looking at the row that has the month dates.

In the real file the dates are in row 11.

I plugged the code in the real file and it is not putting the dates in, but the sample file works fine with the month dates in row 1??

GOT THE REAL FILE WORKING...

[emm]

I "think" I understand--you code does not need the date row because your code is using the changed row for calculating the dates and +3 and -3 take care that the A:C will not house dates??

[Bob Phillips]

Try this

[vba]
Option Explicit

Option Base 1
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim WatchRange As Range
Dim cell As Range
Dim colors As Variant
Dim i As Integer
Dim inputs As Variant
Dim col As Long
Dim iStart As Long
Dim iEnd As Long

On Error GoTo ws_exit
Application.EnableEvents = False

inputs = Array("Office A", "Office B", "Office C", "Office D", "Office E", "Office F")
colors = Array(3, 4, 5, 6, 7, 8)

Set WatchRange = Range("A2:AM" & Rows.Count)
If Intersect(Target, WatchRange) Is Nothing Then Exit Sub
'ACW starts here
With Target
Range("D" & .Row & ":AH" & .Row).ClearContents
If .Column < 4 Then
If Cells(.Row, "B").Value <> "" Then
iStart = Day(Cells(.Row, "B"))
End If
If Cells(.Row, "C").Value <> "" Then
iEnd = Day(Cells(.Row, 3))
End If
If iStart <> 0 And iEnd <> 0 Then
For i = iStart + 3 To iEnd + 3
Cells(.Row, i).Value = i - 3
Next i
End If
End If

Range("D" & .Row & ":AH" & .Row).Interior.ColorIndex = xlColorIndexNone
On Error Resume Next
i = Application.Match(Cells(.Row, "A").Value, inputs, 0)
On Error GoTo 0
If i <> 0 Then
Cells(.Row, "A").Resize(, Application.Count(Range("D" & .Row).Resize(, 31)) + 3).Interior.ColorIndex = colors(i)
End If

End With
ws_exit:
Application.EnableEvents = True
End Sub
[/vba]

[emm]

xld - we are close...

I input:

in A2: Office A

in B2: 3 Nov

in C2: 6 Nov

The office color "started" at Nov 1 and "stopped" at Nov 4,

but it should have "started" 3 Nov and "stopped" at 6 Nov...

[Bob Phillips]

xld - we are close...

I input:

in A2: Office A

in B2: 3 Nov

in C2: 6 Nov

The office color "started" at Nov 1 and "stopped" at Nov 4,

but it should have "started" 3 Nov and "stopped" at 6 Nov...

Of course, sloppy.

[vba]
Option Explicit
Option Base 1

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim WatchRange As Range
Dim cell As Range
Dim colors As Variant
Dim i As Integer
Dim inputs As Variant
Dim col As Long
Dim iStart As Long
Dim iEnd As Long

On Error GoTo ws_exit
Application.EnableEvents = False

inputs = Array("Office A", "Office B", "Office C", "Office D", "Office E", "Office F")
colors = Array(3, 4, 5, 6, 7, 8)

Set WatchRange = Range("A2:AM" & Rows.Count)
If Intersect(Target, WatchRange) Is Nothing Then Exit Sub
'ACW starts here
With Target
Range("D" & .Row & ":AH" & .Row).ClearContents
If .Column < 4 Then
If Cells(.Row, "B").Value <> "" Then
iStart = Day(Cells(.Row, "B"))
End If
If Cells(.Row, "C").Value <> "" Then
iEnd = Day(Cells(.Row, 3))
End If
If iStart <> 0 And iEnd <> 0 Then
For i = iStart + 3 To iEnd + 3
Cells(.Row, i).Value = i - 3
Next i
End If
End If

Range("D" & .Row & ":AH" & .Row).Interior.ColorIndex = xlColorIndexNone
On Error Resume Next
i = Application.Match(Cells(.Row, "A").Value, inputs, 0)
On Error GoTo 0
If i <> 0 Then
Cells(.Row, "A").Resize(, 3).Interior.ColorIndex = colors(i)
Cells(.Row, iStart + 3).Resize(, Application.Count(Range("D" & .Row).Resize(, 31))).Interior.ColorIndex = colors(i)
End If

End With
ws_exit:
Application.EnableEvents = True
End Sub
[/vba]

[emm]

xld - that works great. I'm gonna hold off on hitting the Solved button for a day.

The only thing I might need is to connect a button so update the entire sheet ocassionly. I would think about updating everytime any change is made to the sheet, but that might slow things down--anyway I will run it today and see what happens...

[emm]

I was converting this to the real file and had a break here (this is last rows of code):

I changed all 3s to 12s but it only broke at the one in red below.

Resize(, 31) - is this just for the most number of days in a month?

If i <> 0 Then
Cells(.Row, "A").Resize(, 3).Interior.ColorIndex = colors(i)
Cells(.Row, iStart + 3).Resize(, Application.Count(Range("D" & .Row).Resize(, 31))).Interior.ColorIndex = colors(i)
End If

found it:

Immediate Window, paste Application.EnableEvents = True, hit enter

[emm]

found it:

Immediate Window, paste Application.EnableEvents = True, hit enter

I see what happens, if the code breaks before in gets to that line you have to reset it using the Immediate Window - correct?

[Bob Phillips]

found it:

Immediate Window, paste Application.EnableEvents = True, hit enter

I see what happens, if the code breaks before in gets to that line you have to reset it using the Immediate Window - correct?

No not really. The code has error handling to automatically reset it. You must have had a code break to get it unset, in those cases you are correct.

[emm]

xld - code breaking as indicated below:

1. When I input an office name and then hit enter the code breaks (no dates in B and C).
2. When I delete either of the dates, or one date at a time the code breaks.

If i <> 0 Then
Cells(.Row, "A").Resize(, 3).Interior.ColorIndex = colors(i)
Cells(.Row, iStart + 3).Resize(, Application.Count(Range("D" & .Row).Resize(, 31))).Interior.ColorIndex = colors(i)
End If

[Bob Phillips]

xld - code breaking as indicated below:

1. When I input an office name and then hit enter the code breaks (no dates in B and C).
2. When I delete either of the dates, or one date at a time the code breaks.

If i <> 0 Then
Cells(.Row, "A").Resize(, 3).Interior.ColorIndex = colors(i)
Cells(.Row, iStart + 3).Resize(, Application.Count(Range("D" & .Row).Resize(, 31))).Interior.ColorIndex = colors(i)
End If

Here is another correction.

A question for you. What would you expect if you put 1st Oct as start and 12th Nov as end? It looks odd to me.

[vba]
Option Explicit
Option Base 1

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim WatchRange As Range
Dim cell As Range
Dim colors As Variant
Dim i As Integer
Dim inputs As Variant
Dim col As Long
Dim iStart As Long
Dim iEnd As Long

On Error GoTo ws_exit
Application.EnableEvents = False

inputs = Array("Office A", "Office B", "Office C", "Office D", "Office E", "Office F")
colors = Array(3, 4, 5, 6, 7, 8)

Set WatchRange = Range("A2:AM" & Rows.Count)
If Intersect(Target, WatchRange) Is Nothing Then Exit Sub
With Target
Range("D" & .Row & ":AH" & .Row).ClearContents
Range("A" & .Row & ":AH" & .Row).Interior.ColorIndex = xlColorIndexNone
If .Column < 4 Then
If Cells(.Row, "B").Value <> "" Then
iStart = Day(Cells(.Row, "B"))
End If
If Cells(.Row, "C").Value <> "" Then
iEnd = Day(Cells(.Row, 3))
End If
If iStart <> 0 And iEnd <> 0 Then
For i = iStart + 3 To iEnd + 3
Cells(.Row, i).Value = i - 3
Next i

On Error Resume Next
i = Application.Match(Cells(.Row, "A").Value, inputs, 0)
On Error GoTo 0
If i <> 0 Then
Cells(.Row, "A").Resize(, 3).Interior.ColorIndex = colors(i)
Cells(.Row, iStart + 3).Resize(, _
Application.Count(Range("D" & .Row).Resize(, 31))).Interior.ColorIndex = colors(i)
End If
End If
End If

End With
ws_exit:
Application.EnableEvents = True
End Sub
[/vba]

[emm]

Wellllll, I have 12 sheets--one for each month.

So on the Oct sheet it would show, for that particular row, colored from 1 Oct to 31 Oct and then I would have to go to the other sheet and I would pick the date up at 1 Nov to 15 Nov.

Is that a bad idea?

[Bob Phillips]

Wellllll, I have 12 sheets--one for each month.

So on the Oct sheet it would show, for that particular row, colored from 1 Oct to 31 Oct and then I would have to go to the other sheet and I would pick the date up at 1 Nov to 15 Nov.

Is that a bad idea?

No it wasn't that I was really raising.

As an example, enter a start date of 1st Oct and and en end date of 10th Nov, and 1-10 get coloured. It is a data entry error, but there is nothing to point this out to you (the user?).

Bob

[emm]

No it wasn't that I was really raising.

As an example, enter a start date of 1st Oct and and en end date of 10th Nov, and 1-10 get coloured. It is a data entry error, but there is nothing to point this out to you (the user?).

Bob

hmmm, interesting.

1. I'd rather be able to enter the entire date range on one sheet and then input the differnce manually on the next sheet.

- remember, I have dates running accross the top for each month that originally was used to match intersecting dates, but your your, and acw's code, seems much faster...

2. Question, what does the 31 in this line represent, most days in a month?

Application.Count(Range("D" & .Row).Resize(, 31))).Interior.ColorIndex = colors(i)

[Bob Phillips]

hmmm, interesting.

1. I'd rather be able to enter the entire date range on one sheet and then input the differnce manually on the next sheet.

- remember, I have dates running accross the top for each month that originally was used to match intersecting dates, but your your, and acw's code, seems much faster...

Not really sure what you mean here.

2. Question, what does the 31 in this line represent, most days in a month?

Application.Count(Range("D" & .Row).Resize(, 31))).Interior.ColorIndex = colors(i)

Yes, that is correct.

[emm]

Sample File Setup:

Range A2 houses a name
Range B2:C2 houses a start and end date formatted dd mmm yy
Range D1:AH1 houses days of a month custom formatted to "d"

Real File Setup:
Range A12 and down houses name (use data validation to make sure exact)
Range K12:L12 and down house start and end dates
Range M11:AQ11 house days of a month custom formatted to "d"

I have changed all to:

- Bs to Ks and Cs to Ls
- Ds to Ms and QHs to AQs
- changed all 3s to 12s

I say this becasue I keep getting a break here and can't figure out why:

Cells(.Row, "A").Resize(, 12).Interior.ColorIndex = colors(i)