E
erazmus
Hi Guys,
Hoping someone can shed some light on where I am going wrong here.
I am trying to automate parts of a break rostering system.
The sub is supposed to check through a range which holds each persons
availability, assigned breaks, and other information which would not be
made available to everyone.
When it finds a cell formatted to represent a break it will look up the
person's name and the break time.
It will then search through a second range which is the simple version
of the roster which is sent out to each person.
It searches for the relevant time in this second range to get the cell
address. It then should cycle down each row underneath the target time
until it finds an empty cell where it can then put the person's name.
The part where I am slipping up is "cycle down each row underneath the
target time until it finds an empty cell"
Can someone please look at the following code and advise if there is an
obvious error?
I am quite noob(ish) when it comes to this so feel free to laugh and
point (and provide advice) if there is an easier way of doing this
TIA
Deon.
Private Sub Generate_Roster()
Dim rngTodaysResources, rngTodaysRoster As Range
Dim index, rowCounter, colBreakTime, rowBreakTime, rowBreakName,
colBreakName, colRosterTime, rowRosterTime As Integer
Set rngTodaysResources = Range("A1:AT45")
Set rngTodaysRoster = Range("AV24:BB62")
rowCounter = 0
For Each Cell In rngTodaysResources
If Cell.Interior.Color = vbBlue And Cell.Value = "" Then
colBreakTime = Cell.Column
rowBreakTime = 1
colBreakName = 1
rowBreakName = Cell.Row
targetBreakTime = Cells(rowBreakTime, colBreakTime)
targetName = Cells(rowBreakName, colBreakName)
'' The following returns expected values which means that the
last block of assignments worked
MsgBox targetName & " at " & Format(targetBreakTime, "hh:mm AMPM")
'' Cycle through today's roster to find where the matching time is
in the roster
For index = 1 To rngTodaysRoster.Cells.Count
If rngTodaysRoster.Cells(index).Value = targetBreakTime Then
colRosterTime = rngTodaysRoster.Cells(index).Column
rowRosterTime = rngTodaysRoster.Cells(index).Row
'' This next MsgBox returns expected values, the one after that
does not however.
MsgBox "Match found at " &
rngTodaysRoster.Cells(index).Address & ", Should match row " &
rowRosterTime & " and column " & colRosterTime
'' This next MsgBox returns the right values for rowCounter,
but not for the address,
'' doesn't matter if I use -
'' rngTodaysRoster.Cells(rowRosterTime,
colRosterTime).Offset(rowCounter, 0)
'' or
'' rngTodaysRoster.Cells((rowRosterTime + rowCounter),
colRosterTime)
'' It always states an address which is not anywhere near
correct, usually CQ58 or so.
MsgBox "RowCounter is " & rowCounter & " entering
search at " & rngTodaysRoster.Cells((rowRosterTime + rowCounter),
colRosterTime).Address
'' Never enters this loop. Address issue above.
While rngTodaysRoster.Cells(rowRosterTime,
colRosterTime).Offset(rowCounter, 0).Value <> ""
rowCounter = rowCounter + 1
MsgBox rngTodaysRoster.Cells(rowRosterTime,
colRosterTime).Offset(rowCounter, 0).Address
MsgBox "Value of cell is :" &
rngTodaysRoster.Cells(rowRosterTime, colRosterTime).Offset(rowCounter,
0).Value & ":"
MsgBox "No match found at row " & (rowRosterTime +
rowCounter) & " and column " & colRosterTime
Wend
rngTodaysRoster.Cells(rowRosterTime,
colRosterTime).Offset(rowCounter, 0) = targetName
MsgBox "RowCounter is " & rowCounter & " Exit search at
" & rngTodaysRoster.Cells(rowRosterTime,
colRosterTime).Offset(rowCounter, 0).Address
End If
Next
End If
Next
End Sub
Hoping someone can shed some light on where I am going wrong here.
I am trying to automate parts of a break rostering system.
The sub is supposed to check through a range which holds each persons
availability, assigned breaks, and other information which would not be
made available to everyone.
When it finds a cell formatted to represent a break it will look up the
person's name and the break time.
It will then search through a second range which is the simple version
of the roster which is sent out to each person.
It searches for the relevant time in this second range to get the cell
address. It then should cycle down each row underneath the target time
until it finds an empty cell where it can then put the person's name.
The part where I am slipping up is "cycle down each row underneath the
target time until it finds an empty cell"
Can someone please look at the following code and advise if there is an
obvious error?
I am quite noob(ish) when it comes to this so feel free to laugh and
point (and provide advice) if there is an easier way of doing this
TIA
Deon.
Private Sub Generate_Roster()
Dim rngTodaysResources, rngTodaysRoster As Range
Dim index, rowCounter, colBreakTime, rowBreakTime, rowBreakName,
colBreakName, colRosterTime, rowRosterTime As Integer
Set rngTodaysResources = Range("A1:AT45")
Set rngTodaysRoster = Range("AV24:BB62")
rowCounter = 0
For Each Cell In rngTodaysResources
If Cell.Interior.Color = vbBlue And Cell.Value = "" Then
colBreakTime = Cell.Column
rowBreakTime = 1
colBreakName = 1
rowBreakName = Cell.Row
targetBreakTime = Cells(rowBreakTime, colBreakTime)
targetName = Cells(rowBreakName, colBreakName)
'' The following returns expected values which means that the
last block of assignments worked
MsgBox targetName & " at " & Format(targetBreakTime, "hh:mm AMPM")
'' Cycle through today's roster to find where the matching time is
in the roster
For index = 1 To rngTodaysRoster.Cells.Count
If rngTodaysRoster.Cells(index).Value = targetBreakTime Then
colRosterTime = rngTodaysRoster.Cells(index).Column
rowRosterTime = rngTodaysRoster.Cells(index).Row
'' This next MsgBox returns expected values, the one after that
does not however.
MsgBox "Match found at " &
rngTodaysRoster.Cells(index).Address & ", Should match row " &
rowRosterTime & " and column " & colRosterTime
'' This next MsgBox returns the right values for rowCounter,
but not for the address,
'' doesn't matter if I use -
'' rngTodaysRoster.Cells(rowRosterTime,
colRosterTime).Offset(rowCounter, 0)
'' or
'' rngTodaysRoster.Cells((rowRosterTime + rowCounter),
colRosterTime)
'' It always states an address which is not anywhere near
correct, usually CQ58 or so.
MsgBox "RowCounter is " & rowCounter & " entering
search at " & rngTodaysRoster.Cells((rowRosterTime + rowCounter),
colRosterTime).Address
'' Never enters this loop. Address issue above.
While rngTodaysRoster.Cells(rowRosterTime,
colRosterTime).Offset(rowCounter, 0).Value <> ""
rowCounter = rowCounter + 1
MsgBox rngTodaysRoster.Cells(rowRosterTime,
colRosterTime).Offset(rowCounter, 0).Address
MsgBox "Value of cell is :" &
rngTodaysRoster.Cells(rowRosterTime, colRosterTime).Offset(rowCounter,
0).Value & ":"
MsgBox "No match found at row " & (rowRosterTime +
rowCounter) & " and column " & colRosterTime
Wend
rngTodaysRoster.Cells(rowRosterTime,
colRosterTime).Offset(rowCounter, 0) = targetName
MsgBox "RowCounter is " & rowCounter & " Exit search at
" & rngTodaysRoster.Cells(rowRosterTime,
colRosterTime).Offset(rowCounter, 0).Address
End If
Next
End If
Next
End Sub