Compare two Excel sheets.
Closed
FirstLog
Posts
2
Registration date
Wednesday June 14, 2017
Status
Member
Last seen
June 19, 2017
-
Updated on Jun 14, 2017 at 05:38 AM
Blocked Profile - Jun 14, 2017 at 05:02 PM
Blocked Profile - Jun 14, 2017 at 05:02 PM
Related:
- Compare two Excel sheets.
- Mark sheet in excel - Guide
- Beyond compare - Download - File management
- Sheets right to left - Guide
- Excel compare two sheets - Guide
- How to open excel sheet in notepad++ - Guide
1 response
I would be more than happy to assist.
Take the above example, and cut and paste the parts that help you out!
It's kind of fun to do the impossible! -Walter Elias Disney
Option Explicit
Dim ApplicationID
Dim ActionCnt
Dim StartTimeForProcess
Dim endtimeforProcess
Dim QualifiedEntryText()
Dim DisqualifiedEntryText()
Dim includeEntry
Dim qst, dqst
Sub ConfigureLogic()
Dim qstEntries
Dim dqstEntries
Dim qstCnt, dqstCnt
qstEntries = Range("QualifiedEntry").Count
qst = qstEntries - WorksheetFunction.CountIf(Range("QualifiedEntry"), "")
ReDim QualifiedEntryText(qst)
'MsgBox (qst)
dqstEntries = Range("DisQualifiedEntry").Count
dqst = dqstEntries - WorksheetFunction.CountIf(Range("DisQualifiedEntry"), "")
ReDim DisqualifiedEntryText(dqst)
'MsgBox (dqst)
For qstCnt = 1 To qst
QualifiedEntryText(qstCnt) = ThisWorkbook.Worksheets("Qualifiers").Range("J" & 8 + qstCnt).value
'MsgBox (QualifiedEntryText(qstCnt))
logging ("Configured Qualified Entry entry #" & qstCnt & " as {" & QualifiedEntryText(qstCnt) & "}")
Next
For dqstCnt = 1 To dqst
DisqualifiedEntryText(dqstCnt) = ThisWorkbook.Worksheets("Qualifiers").Range("M" & 8 + dqstCnt).value
'MsgBox (DisqualifiedEntryText(dqstCnt))
logging ("Configured DisQualified Entry entry #" & qstCnt & " as {" & DisqualifiedEntryText(dqstCnt) & "}")
Next
includeEntry = ThisWorkbook.Worksheets("Qualifiers").Range("IncludeSibling").value
'MsgBox (includeEntry)
logging ("Entrys included in search - " & includeEntry)
End Sub
Sub StartSelection()
Dim startornot
Dim dtDuration As Long
Dim minlength
Dim WhoIsPerforming
Dim StartMessage As String
StartMessage = "You are attempting to Start the Selection Process. Continue?"
WhoIsPerforming = Environ("username")
startornot = MsgBox(StartMessage, vbYesNoCancel)
If startornot <> 6 Then
logging ("Start Cancelled by [" & UCase(WhoIsPerforming) & "] with value of " & startornot)
Exit Sub
Else
logging ("User [" & UCase(WhoIsPerforming) & "] Started Selection Process.")
'Exit Sub
End If
Application.ScreenUpdating = True
ActionCnt = 0
StartTimeForProcess = Now()
logging ("Selection Start")
ConfigureLogic
logging ("Configured Logic")
'**********************************************************************************************************************
'*****This is the call to start the sheets counter, which iterates through each worksheet in the workbook*****************
'***************************************************************************************************************************
Call CountSheets
ActionCnt = ActionCnt + 1
endtimeforProcess = Now()
logging ("Selection End")
dtDuration = DateDiff("s", CDate(StartTimeForProcess), CDate(endtimeforProcess))
minlength = dtDuration / 60
logging ("Number of Transactions [" & ActionCnt & "] in " & dtDuration & " seconds (" & minlength & " mins)")
ThisWorkbook.Worksheets(1).Select
End Sub
Private Sub CountSheets()
Dim sheetcount
Dim WS As Worksheet
sheetcount = 0
logging ("*****Starting Scrub*********")
For Each WS In ThisWorkbook.Worksheets
sheetcount = sheetcount + 1
If (WS.Name <> "Controller") Then
If (WS.Name <> "Qualifiers") Then
If WS.Name <> "EntryDropped" Then
If WS.Name <> "Logging" Then
If WS.Name <> "Selected" Then
'need to log the date and time into sheet named "Logging"
ActionCnt = ActionCnt + 1
logging ("Calling sheet: " & WS.Name)
scrubsheet (sheetcount)
Else
ActionCnt = ActionCnt + 1
logging ("Skipped over sheet: " & WS.Name)
End If
Else
ActionCnt = ActionCnt + 1
logging ("Skipped over sheet: " & WS.Name)
End If
Else
ActionCnt = ActionCnt + 1
logging ("Skipped over sheet: " & WS.Name)
End If
Else
ActionCnt = ActionCnt + 1
logging ("Skipped over sheet: " & WS.Name)
End If
Else
ActionCnt = ActionCnt + 1
logging ("Skipped over " & WS.Name)
End If
Next WS
'MsgBox ("ending")
ActionCnt = ActionCnt + 1
logging ("****Scrub DONE!")
Application.ScreenUpdating = True
End Sub
Private Function logging(whatvalue)
Dim cellcount
Dim thecelltoinput
Dim Osheet
Osheet = ThisWorkbook.ActiveSheet.Name
ThisWorkbook.Worksheets("Logging").Select
thecelltoinput = 0
whatvalue = Now & "--" & ActionCnt & "--" & whatvalue
cellcount = Cells(ThisWorkbook.Worksheets("Logging").Rows.Count, 1).End(xlUp).Row
'MsgBox (cellcount & "was the count")
thecelltoinput = cellcount + 1
ThisWorkbook.Worksheets("Logging").Range("a" & thecelltoinput).value = whatvalue
ThisWorkbook.Worksheets(Osheet).Select
End Function
Sub SortTheSheet()
Range("A6:AZ9999").Sort key1:=Range("AW5"), _
order1:=xlDescending, Header:=xlNo
Range("A6:AZ9999").Sort key1:=Range("AT5"), _
order1:=xlAscending, Header:=xlNo
End Sub
Private Sub scrubsheet(WS)
Dim z
Dim placevalue
Dim RefRange, firstrange, SelectionRange, thirdrange, fourthrange, Entryrange, WeightedSelectionRange
Dim SelectionExists
Dim NumberOfSeats, NumOfSelectedSeatsCount
Dim Loggingentry, loggingSTMNT
Dim Nret, retNum
Dim worksheetName
Dim TypeOfPlace 'Number of Seats Per place
Dim PlaceType 'small medium or large place
Dim SeatsPerPlace()
Dim Seat0, Seat1, Seat2, Seat3, Seat4, Seat5
Dim SeatLevel
Dim LevelName
Dim SelectionAction
Dim whatrow
Dim WeightedSelection
Dim IsAssociate
Dim gradecount
Dim loggingCnt
Dim lookfordisqualified
Dim lookforqualified
IsAssociate = 0
ActionCnt = ActionCnt + 1
ThisWorkbook.Worksheets(WS).Select
worksheetName = ThisWorkbook.Worksheets(WS).Name
NumberOfSeats = ThisWorkbook.Worksheets(WS).Range("A4").value
SelectionExists = Range("M2").value
If SelectionExists = "NA" Then
'**********DEBUG****************************************************
'MsgBox ("No Selection on sheet " & Worksheets(WS).Name)
'*******************************************************************
logging ("No Selection on sheet: " & worksheetName)
SelectionExists = 0
Else
logging ("Located Winning Selection #: " & SelectionExists & " for " & worksheetName)
End If
If NumberOfSeats = 0 Then
Loggingentry = "***Warning - No Seats configured for " & worksheetName & ". Please verify Planning numbers are correct.***"
logging (Loggingentry)
'Loggingentry = "VV Premature Exit from run on [" & worksheetName & "]. VV"
'logging (Loggingentry)
'Exit Sub
End If
'***********************************************************************************************
'******************This section sets up the variable grade seats that are **********************
'****************** available to each Place. The variables are stored in *********************
'****************** the array of SeatsPerPlace(N) **********************************************
'****************** SeatPerGrade(N) has the MAX number of each Seat Level per Place ****************
'******************As each seat is identified as selected, we subtract one from the ************
'****************** Appropriate place in th earray. We continue to select until the ***********
'****************** app. place has 0, then those applicants are put on a waiting list**************
'***********************************************************************************************
TypeOfPlace = 0
'need to load array SeatsPerPlace by identifying what kind of Place it is
retNum = InStr(1, worksheetName, "Small", vbTextCompare)
If retNum <> 0 Then
TypeOfPlace = 5 'Small
PlaceType = "Small Place"
End If
retNum = InStr(1, worksheetName, "Medium", vbTextCompare)
If retNum <> 0 Then
TypeOfPlace = 2 'Medium Place
PlaceType = "Medium Place"
End If
retNum = InStr(1, worksheetName, "Large", vbTextCompare)
If retNum <> 0 Then
TypeOfPlace = 3 'Large Place
PlaceType = "Large Place"
End If
logging ("Found " & worksheetName & " is a " & PlaceType & ", and has [" & TypeOfPlace + 1 & "] grades in it.")
ReDim SeatsPerPlace(TypeOfPlace + 1)
For gradecount = 0 To TypeOfPlace
SeatsPerPlace(gradecount) = ThisWorkbook.Worksheets(WS).Cells(2, 7 + gradecount).value
Next
logging ("Loaded the SeatsPerPlace(" & TypeOfPlace & ") Array as follows below:")
For loggingCnt = 0 To TypeOfPlace
loggingSTMNT = "Place: " & worksheetName & "--SeatsPerPlace(" & loggingCnt & "): " & SeatsPerPlace(loggingCnt)
logging (loggingSTMNT)
Next
z = Cells(ThisWorkbook.Worksheets(WS).Rows.Count, 1).End(xlUp).Row
If z > SelectionExists Then
ActionCnt = ActionCnt + 1
logging ("Disregarding Selection results, as the number of Seats is greater than the number of Applicants/Selection Winners!")
End If
If z > 5 Then
'WaitingList (WS)
NumOfSelectedSeatsCount = 0
'**************************Selected List Formula below***************
'************need to see if we want to include siblings from the Qualifiers sheet
If LCase(includeEntry) = "no" Then
GoTo skipthesiblings
End If
For placevalue = 6 To z
RefRange = "C" & placevalue
firstrange = "AR" & placevalue
SelectionRange = "AW" & placevalue
thirdrange = "AT" & placevalue
fourthrange = "AU" & placevalue
Entryrange = "AS" & placevalue
WeightedSelectionRange = "AX" & placevalue
For lookfordisqualified = 1 To dqst 'loops through array to find all matching text from DisqualifiedEntry on Qualifiers sheet
If LCase(Range(Entryrange).value) Like DisqualifiedEntryText(lookfordisqualified) Then
ActionCnt = ActionCnt + 1
logging ("[" & worksheetName & "] [refID(" & Range(RefRange).value & ")] found an associate, was dropped: " & Range(Entryrange).value)
Nret = selectRow(placevalue, "EntryDropped")
logging ("Above Applicant was placed in Entry Dropped sheet for audit")
GoTo skiptherecord
End If
Next
For lookforqualified = 1 To qst 'loops through array to find all matching text from QualifedSibling on Qualifiers sheet
If LCase(Range(Entryrange).value) Like QualifiedEntryText(lookforqualified) Then
ActionCnt = ActionCnt + 1
logging ("**** [" & worksheetName & "] found an associate: " & Range("AS" & placevalue).value)
'WeightedSelection = Range(SelectionRange).value + 10000
WeightedSelection = Range(SelectionRange).value 'no weight added to Selection number, just identify as sibling in next column over.
logging ("->Placed a marker for RefID[" & Range(RefRange).value & "]")
Range(WeightedSelectionRange).value = Range(SelectionRange).value
'Range(SelectionRange).value = WeightedSelection
End If
Next
skiptherecord:
Next
skipthesiblings:
ActionCnt = ActionCnt + 1
logging ("End of Entry scrub for - " & worksheetName & ".")
ActionCnt = ActionCnt + 1
SortTheSheet
logging ("Sorted worksheet [" & worksheetName & "] for Selection Selection...")
For placevalue = 6 To z
IsAssociate = 0 'default is 0=not a sibling/1=is a sibling for seat counts
RefRange = "C" & placevalue
firstrange = "AR" & placevalue
SelectionRange = "AW" & placevalue
thirdrange = "AT" & placevalue
fourthrange = "AU" & placevalue
Entryrange = "AS" & placevalue
WeightedSelectionRange = "AX" & placevalue
'****Need to find all of the selected 1st Place choices, and then see how many seats are left over.
If ((Range(firstrange).value = "Approved") _
And _
(NumOfSelectedSeatsCount <= NumberOfSeats) _
And _
(Range(SelectionRange).value >= SelectionExists) _
And _
(Range(SelectionRange).value <> "") _
And _
(Range(thirdrange).value = 1) _
And _
(LCase(Range(fourthrange).value) = LCase(worksheetName))) Then
If Range(WeightedSelectionRange).value <> "" Then
logging ("Trapped Entry [refID - " & Range(RefRange).value & "]...")
IsAssociate = 1
End If
GoSub CheckForSeats
End If
Next
'end of 1st preference scrub
ActionCnt = ActionCnt + 1
logging ("End of Primary scrub for - " & worksheetName & ".")
For placevalue = 6 To z
RefRange = "C" & placevalue
firstrange = "AR" & placevalue
SelectionRange = "AW" & placevalue
thirdrange = "AT" & placevalue
fourthrange = "AU" & placevalue
Entryrange = "AS" & placevalue
WeightedSelectionRange = "AX" & placevalue
'************************Check to see if Place is selected and there is available seats to select
If ((Range(firstrange).value = "Approved") _
And _
(NumOfSelectedSeatsCount < NumberOfSeats) _
And _
(Range(SelectionRange).value < SelectionExists) _
And _
(Range(SelectionRange).value <> "") _
And _
(Range(thirdrange).value = 1) _
And _
(LCase(Range(fourthrange).value) = LCase(worksheetName))) Then
GoSub CheckForSeats
logging ("Above Applicant [" & ApplicationID & "] did not win Selection...")
logging ("...sent to check for available seat. Result [" & SelectionAction & "] (0=selected, 1 = WaitingList)")
'NumOfSelectedSeatsCount = NumOfSelectedSeatsCount + 1
'Else
'**************************Waiting List Formula below***************
' If ((Range(firstrange).value = "Approved") _
' And _
' (Range(SelectionRange).value < SelectionExists) _
' And _
' (Range(SelectionRange).value <> "") _
' And _
' (Range(thirdrange).value = 1) _
' And _
' (LCase(Range(fourthrange).value) = LCase(worksheetName))) Then
' GoSub CheckForSeats
' 'Nret = selectRow(placevalue, "WaitingList")
' End If
End If
Next
Else
ActionCnt = ActionCnt + 1
Loggingentry = "No Valid Entries for Sheet: " & worksheetName
logging (Loggingentry)
End If
ActionCnt = ActionCnt + 1
logging ("~~Finish of Scrub, now closing Sheet: " & worksheetName)
Exit Sub
PlaceOnSheet:
If SelectionAction = 0 Then 'Selected
Nret = selectRow(placevalue, "Selected")
NumOfSelectedSeatsCount = NumOfSelectedSeatsCount + 1
Loggingentry = "Seat selection #" & NumOfSelectedSeatsCount & ", with " & SeatsPerPlace(LevelName) & " seats left "
If LevelName = "0" Then LevelName = "Bowl"
Loggingentry = Loggingentry & " in the (" & LevelName & ") grade level"
logging (Loggingentry)
End If
If SelectionAction = 1 Then 'Waitinglist
logging ("Waiting List Placement...")
Nret = selectRow(placevalue, "WaitingList")
End If
If SelectionAction = 2 Then 'SIBLING
Nret = selectRow(placevalue, "SELECTED")
NumOfSelectedSeatsCount = NumOfSelectedSeatsCount + 1
logging ("Placed Entry in Selected listing.")
End If
Return
CheckForSeats:
ActionCnt = ActionCnt + 1
SeatLevel = 0
LevelName = 0
SeatLevel = ThisWorkbook.Worksheets(WS).Range("AN" & placevalue).value
'MsgBox ("Applicant is in grade: " & SeatLevel)
GoSub SetupGrade
'MsgBox ("SeatLevel was converted to name of: " & LevelName)
'MsgBox ("there are " & SeatsPerPlace(LevelName) & " seats in " & SeatLevel & " for this Place.")
If IsAssociate = 1 Then 'this Applicant is a sibling and wins a seat regardless
If SeatsPerPlace(LevelName) <= 0 Then
SelectionAction = 1
Else
SelectionAction = 2
End If
SeatsPerPlace(LevelName) = SeatsPerPlace(LevelName) - 1
GoSub PlaceOnSheet
Return
End If
If SeatsPerPlace(LevelName) > 0 Then
SeatsPerPlace(LevelName) = SeatsPerPlace(LevelName) - 1
SelectionAction = 0
GoSub PlaceOnSheet
Return
End If
If SeatsPerPlace(LevelName) <= 0 Then
SelectionAction = 1
GoSub PlaceOnSheet
Return
End If
Return
SetupGrade:
If TypeOfPlace = 5 Then 'Small
If LCase(SeatLevel) = "Bowl" Then
LevelName = 0
End If
If LCase(SeatLevel) = 1 Then
LevelName = 1
End If
If LCase(SeatLevel) = 2 Then
LevelName = 2
End If
If LCase(SeatLevel) = 3 Then
LevelName = 3
End If
If LCase(SeatLevel) = 4 Then
LevelName = 4
End If
If LCase(SeatLevel) = 5 Then
LevelName = 5
End If
End If
If TypeOfPlace = 2 Then 'Medium
If LCase(SeatLevel) = 1 Then
LevelName = 0
End If
If LCase(SeatLevel) = 2 Then
LevelName = 1
End If
If LCase(SeatLevel) = 3 Then
LevelName = 2
End If
End If
If TypeOfPlace = 3 Then 'Large
If LCase(SeatLevel) = "Bowl" Then
LevelName = 0
End If
If LCase(SeatLevel) = 1 Then
LevelName = 1
End If
If LCase(SeatLevel) = 2 Then
LevelName = 2
End If
If LCase(SeatLevel) = 3 Then
LevelName = 3
End If
End If
Return
End Sub
Private Function selectRow(whatrow, whatsheet)
Dim X
Dim thecell
Dim LoggingRowID
Dim AppID
Dim AppsLotto
Dim WinningLotto
Dim Nret
Dim WSOriginal 'need to keep track of what sheet we are working on as the subroutine cascades
Dim LogString
WSOriginal = ThisWorkbook.ActiveSheet.Name 'we have a value for the active sheet to return too
'*********************************************************
'**Sets up logging string Construct for Auditing *************
'****************************************************************
LoggingRowID = Range("A" & whatrow).value
AppID = Range("B" & whatrow).value
AppsLotto = Range("AW" & whatrow).value
WinningLotto = Range("M2").value
If LCase(whatsheet) = "selected" Then
LogString = "-->>"
End If
ApplicationID = ""
ApplicationID = AppID
'***************************************************************
'****END OF LOGGING CONSTRUCT*******************************
'****************************************************
ActiveSheet.Range("A" & whatrow).EntireRow.Select 'Find the Row we are scrubbng and highlight it for copying and pasting
Selection.Copy
logging (LogString & whatsheet & " Entry - Copying Row [" & LoggingRowID & "] ...")
logging ("... APPID={" & AppID & "} " & _
"from [" & WSOriginal & "]. Apps Lotto: " & AppsLotto)
ThisWorkbook.Worksheets(whatsheet).Select ' now that we have the original sheet, we can switch to the appropriate(dynamically selected) list sheet.
X = Cells(ThisWorkbook.Worksheets(whatsheet).Rows.Count, 1).End(xlUp).Row
thecell = X + 1
Nret = copyRow(thecell, whatsheet)
ThisWorkbook.Worksheets(WSOriginal).Select 'Return to the original sheet for the next record
'Range("A1").Activate
'Application.CutCopyMode = False
End Function
Private Function copyRow(whatrow, whatsheet)
ActiveSheet.Paste Destination:=Worksheets(whatsheet).Range("A" & whatrow)
Application.CutCopyMode = False
End Function
Take the above example, and cut and paste the parts that help you out!
It's kind of fun to do the impossible! -Walter Elias Disney