Code:
Sub GetsathishsusaStarted() ' http://www.excelfox.com/forum/showthread.php/2161-Highlight-Overlap-dates?p=10177#post10177
Rem 1) Worksheets Info
Dim WSt As Worksheet 'EP Dim: For Object variables: Address location to a "pointer". That has all the actual memory locations (addresses) of the various property values , and it holds all the instructions what / how to change them , should that be wanted later. That helps to explain what occurs when passing an Object to a Call ed Function or Sub Routine By Val ue. In such an occurrence, VBA actually passes a copy of the pointer. So that has the effect of when you change things like properties on the local variable , then the changes are reflected in changes in the original object. (The copy pointer instructs how to change those values, at the actual address held in that pointer). That would normally be the sort of thing you would expect from passing by Ref erence. But as that copy pointer "dies" after the called routine ends, then any changes to the Addresses of the Object Properties in the local variable will not be reflected in the original pointer. So you cannot actually change the pointer.)
Set WSt = ThisWorkbook.Worksheets("sheet1") ' 'EP Set: Fill or partially Fill: Setting to a Class will involve the use of an extra New at this code line. I will then have an Object referred to as an instance of a Class. At this point I include information on my Pointer Pigeon hole for a distinct distinguishable usage of an Object of the Class. For the case of something such as a Workbook this instancing has already been done, and in addition some values are filled in specific memory locations which are also held as part of the information in the Pigeon Hole Pointer. We will have a different Pointer for each instance. In most excel versions we already have a few instances of Worksheets. Such instances Objects can be further used., - For this a Dim to the class will be necessary, but the New must be omitted at Set. I can assign as many variables that I wish to the same existing instance
Rem 2) Checked Names info
'2a) Arrays of data, value(Boolean) and employee name
Dim RngChk As Range
Set RngChk = WSt.Range("AS8:AT11")
Dim arrChkEmp() As Variant, arrEmp() As Variant ' A simple one line code is used typically wherby the .Value "string values" Property is used to return the cell value from a Range object. These are contained in an Array of Variant types. These can be assigned in VBA to an array of appropriately declared (Dim ed) Member Element types, Variant in this case.
Let arrChkEmp() = RngChk.Resize(, 1).Value ' AS ' Using Resize ing Property applied to a Range object - the Range object resized to (nochange to rows, change to 1 column) effectively returns the first column as a Range object
Let arrEmp() = RngChk.Offset(0, 1).Resize(, 1).Value ' AT ' Before Resize, Offset Property applied to shift enclosed spreadsheet range (no shift in row direction , 1 column shift to the right)
'2b) Build string and Array of Employes checked as True
'2b)(i)
Dim Cnt As Long ' Loop Bound variable Count ' Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in. '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. )
Dim strEmp As String ' ' Prepares "Pointer" to a "Blue Print" (or Form, Questionaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular "Value", or ("Values" for Objects). There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. A String is a a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
Let strEmp = "Overlap dates Between " 'Initial string
'2b(ii)
Dim TrueCnt As Long: Let TrueCnt = 0 ' Count of checked as True employees
For Cnt = 1 To UBound(arrChkEmp(), 1) ' For all employee "rows"
Dim arrChkTrueEmp() As String ' I know the type and am looping to fill in so can choose type
If arrChkEmp(Cnt, 1) = True Then ' Box is checked resulting in Boolean True held in Range object of cell - "...I do not know anything about check boxes. :( ... So I look at TRUE or FALSE value in Array of captured valuees from Range("AS8:AS11")
Let strEmp = strEmp & arrEmp(Cnt, 1) & " and " ' ( '2b)(i) ) add checked names to initial string report for output
Let TrueCnt = TrueCnt + 1 ' Increase count of true checked names ...
ReDim Preserve arrChkTrueEmp(1 To TrueCnt) ' ... Increase array size to accomodate another True name
Let arrChkTrueEmp(TrueCnt) = arrEmp(Cnt, 1) ' Fill next space in Array with next checked as True name
Else
End If
Next Cnt
Let strEmp = Left(strEmp, Len(strEmp) - 5) ' omit last " and "
Rem 3) Main Input data
'3a) Full data range as range object
Dim RngDta As Range
Set RngDta = WSt.Range("B21:E26")
'3b)
Dim arrListNms() As Variant, arrFrm() As Variant, arrTo() As Variant, arrOvrLpDts() As Variant
Let arrListNms() = RngDta.Resize(, 1).Value
Let arrFrm() = RngDta.Offset(0, 1).Resize(, 1).Value2
Let arrTo() = RngDta.Offset(0, 2).Resize(, 1).Value2
Let arrOvrLpDts() = RngDta.Offset(0, 3).Resize(, 1).Value ' RngDta.Offset(0, 3).Resize(, 1).Interior.Color = 255
Rem 4) Main Outer Loop ==============Cnt========= Dim StearEmp As Variant
For Cnt = 1 To UBound(arrListNms(), 1) ' Outer Loop is each name in column B 'Each StearEmp In arrChkTrueEmp()
'4a)
Dim NmeMtch As Variant ' For result of attempt to find next name(Cnt) in arrChkTrueEmp()
Let NmeMtch = Application.Match(arrListNms(Cnt, 1), arrChkTrueEmp(), 0)
If Not IsError(NmeMtch) Then ' This is the case we have found a name I want to check against
Dim CntIn As Long
Rem 5) Inner Loop ------------------CntIn--------
For CntIn = 1 To UBound(arrListNms(), 1)
If arrListNms(Cnt, 1) <> arrListNms(CntIn, 1) Then ' To ignore compare employee with himself
Let NmeMtch = Application.Match(arrListNms(CntIn, 1), arrChkTrueEmp(), 0)
If Not IsError(NmeMtch) Then ' This is the case we have found a name I want to check against
' Now is main part of criteria check
If (arrFrm(Cnt, 1) >= arrFrm(CntIn, 1) And arrFrm(Cnt, 1) <= arrTo(CntIn, 1)) Or (arrTo(Cnt, 1) >= arrFrm(CntIn, 1) And arrTo(Cnt, 1) <= arrTo(CntIn, 1)) Then ' main comdition for match
Let arrOvrLpDts(CntIn, 1) = "Overlap"
Else ' Main overlap condition not met
End If
Else ' Case The Employee name was not one that was checked true to check for Holiday overlap
End If
Else ' case of Checked employee is in Employee Names list
End If
Next CntIn '---End Inner Loop ---------
Else ' Case The outer loop for all names was at a name not to be compared - do nothing and go on to next name in column B
End If ' do nothing and go on to next name in column B at next line
Next Cnt ' --End Main Outer loop ============== ' StearEmp
Rem 6) Loop through arrOvrLpDts() Array to add to report string and mark cell
For Cnt = 1 To UBound(arrOvrLpDts(), 1)
If arrOvrLpDts(Cnt, 1) = "Overlap" Then
Let strEmp = strEmp & vbCrLf & arrListNms(Cnt, 1) & " From " & Format(arrFrm(Cnt, 1), "d" & "-" & "mmm" & "-" & "yyyy") & " To " & Format(arrTo(Cnt, 1), "d" & "-" & "mmm" & "-" & "yyyy") & ""
Let RngDta.Offset(0, 3).Resize(, 1).Item(Cnt).Interior.Color = 255
Else
End If
Next Cnt
Rem 7) Message Box output of report string
MsgBox prompt:="" & strEmp & ""
End Sub
Reply With Quote
Originally Posted by Doc.AElstein
Bookmarks