I have a VBA Module that is trying to get all occurrences of a date in column G in one sheet. After finding the row of the occurrence, I'm saving other values from the sheet on the same row from different columns, i.e. bldg, and room, and numPerson.
What I'm trying to do after that is to get the call a function with the date, numPerson, bldg and room as arguments. The function FillDateCapacitiesInOccupancySheet should go to a different sheet and search column B for the bldg, get that row, then look for the room on the same row and place the numPpl on the row under the correct column for the date that was given. In the following code I get an Error 91 on the Loop While statement if I remove
If FoundCell Is Nothing Then
MsgBox "No Found Cell Address", vbInformation
Exit Sub
End If
The click function works fine if I remove the call to the function FillDateCapacitiesInOccupancySheet, but otherwise I get an error. Either the FoundCell or myRange is empty but I'm not sure why or how to fix it.
Sub ConflictButton_Click()
Dim sourceColumn As Range
Dim targetColumn As Range
Dim beginningDate As String, stringDate As String, month As String, day As String, year As String
Dim dates As Date
Dim occWS As Worksheet, excepWS As Worksheet
Dim beginningDateCell As Range, addDatesCells As Range, FindDateRow As Range
Dim datesArray(1 To 7) As Date, stringDatesArray(1 To 7) As String
Dim lLoop As Long, findRowNumber As Long
Dim tempMonth As String, tempDay As String
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
'Copy Building, Room, and Max Capacity Columns from sheet Table to sheet OccupancyByDate
Set sourceColumn = ThisWorkbook.Worksheets("Table").Columns("B:D").Rows("3:500")
Set targetColumn = ThisWorkbook.Worksheets("OccupancyByDate").Columns("B:D").Rows("3:500")
sourceColumn.Copy Destination:=targetColumn
'open FindConflictDates Form
FindConflictDatesForm.Show
'Set OccupancyByDate sheet Column E Row 2 (Column Header) to the Week Starting Date,
'get the week beginning string from what was saved from the FindConflictDatesForm
If WeekBeginningString <> "" Then
beginningDate = WeekBeginningString
WeekBeginningDate = CDate(beginningDate) ' convert String to Date
Set occWS = ThisWorkbook.Sheets("OccupancyByDate")
Set excepWS = ThisWorkbook.Sheets("Telework Exceptions")
' Fill the 7 dates into header in OccupanyByDate sheet Columns E - K row 2
Dim i As Integer
i = 1
For j = 5 To 11 ' From column E(5) to K (11)
dates = WeekBeginningDate - Weekday(WeekBeginningDate, vbUseSystemDayOfWeek) + i
occWS.Cells(2, j).Value = Format(dates, "dd-mmm-yyyy") ' write dates to OccByDate sheet
'Save dates to datesArray
datesArray(i) = dates
stringDate = CStr(dates) ' convert date to string
If Mid(stringDate, 2, 1) <> "/" Then ' 2 digit month
tempMonth = Left(stringDate, 2)
Else
tempMonth = Left(stringDate, 1) ' 1 digit month
month = GetMonthAbbreviation(tempMonth)
End If
If Left(Right(stringDate, 7), 1) <> "/" Then '2 digit day
day = Left(Right(stringDate, 7), 2)
Else
day = Left(Right(stringDate, 6), 1) ' 1 digit day
' day = Mid(stringDate, 4, 2)
End If
year = Right(stringDate, 4)
stringDatesArray(i) = day & "-" & month & "-" & year
i = i + 1 ' Add 1 to increment date of week
Next j
''''''''''''''''''''''''
' Search for dates on the TW Exception Sheet
Dim numPerson As Long, Bldg As String, Room As String, foundDate As String
numPerson = 0
For i = LBound(datesArray) To UBound(datesArray)
'Search for datesArray(i) on TW Exceptions sheet
Set myRange = excepWS.Range("G:G")
Set LastCell = myRange.Cells(myRange.Cells.count)
Set FoundCell = myRange.Find(what:=stringDatesArray(i), after:=LastCell, LookIn:=xlValues)
If Not FoundCell Is Nothing Then ' if value found in column
FirstFound = FoundCell.Address
findRowNumber = FoundCell.Row 'get row number of the found date in the column on TW Excep sheet
foundDate = FoundCell.Text 'get text value of first occurence of new date found in column
Do ' Find additional occurences of date in the sheet column
findRowNumber = FoundCell.Row
If FoundCell.Offset(0, -3).Value = 1 Then
numPerson = 1
End If
If FoundCell.Offset(0, -2).Value = 1 Then
numPerson = 1
End If
Bldg = FoundCell.Offset(0, 3).Text
Room = FoundCell.Offset(0, 4).Text
FillDateCapacitiesInOccupancySheet foundDate, numPerson, Bldg, Room 'if i remove this line I don't get an error
Set FoundCell = myRange.FindNext(FoundCell)
If FoundCell Is Nothing Then
MsgBox "No Found Cell Address", vbInformation
Exit Sub
End If
Loop While (FoundCell.Address <> FirstFound)
End If
Next i 'Get next dateArray value
End If 'End if WeekBeginningString <> ""
End Sub
Sub FillDateCapacitiesInOccupancySheet(fndDate As String, numPpl As Long, Buildg As String, Rm As String)
Dim occWS As Worksheet
Dim FndCell As Range, rng As Range
Dim myNewRange As Range, LastCell As Range
Dim foundBldg As String
Dim findRowNumber As Long, count As Long
Dim dateOffset As Integer
Dim FirstFound As String
count = 0
Set occWS = ThisWorkbook.Sheets("OccupancyByDate")
Set myNewRange = occWS.Range("B:B") ' search in building column
Set LastCell = myNewRange.Cells(myNewRange.Cells.count)
Set FndCell = myNewRange.Find(what:=Buildg, after:=LastCell, LookIn:=xlValues)
If Not FndCell Is Nothing Then ' if value found in column
FirstFound = FndCell.Address
findRowNumber = FndCell.Row 'get row number of the found building in the column on OccByDate sheet
foundBldg = FndCell.Text 'get text value of first occurence of new building found in column
Do ' Find additional occurences of date in the sheet column
findRowNumber = FndCell.Row
If FndCell.Offset(0, 1).Text = Rm Then ' if room passed into function equals room for the building
'Find the date column for the date passed into function
For j = 5 To 11 ' From column E(5) to K (11)
If occWS.Cells(2, j).Text = fndDate Then
dateOffset = j - 2
count = FndCell.Offset(0, dateOffset).Value + numPpl
' write count to cell
FndCell.Offset(0, dateOffset).Value = count
End If
Next j
End If
Set FndCell = myNewRange.FindNext(FndCell)
Loop While (FndCell.Address <> FirstFound)
End If
End Sub
Any help would be greatly appreciated.
