Report

Compare two Excel sheets.

Ask a question FirstLog 2Posts Wednesday June 14, 2017Registration date June 19, 2017 Last seen - Last answered on Jun 14, 2017 at 05:02 PM by ac3mark
Dear Sir,
i have worked in excel 2007 facing a big problem, actually i have 2 excel sheet which on generated billing software n other one maintain manually and on months last we required to compare both... Invoice No, Pcs, Waight and Amount would be equal in both sheet.... its very tidy to handle please help me to create a easy process

thanking you

vineet sharma
See more 
Helpful
+0
plus moins
I would be more than happy to assist.


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!

Leave a comment

Member requests are more likely to be responded to.

Members can monitor the statuses of their requests from their account pages.

A CCM membership gives you access to additional options.

Not a member yet?

Sign up now. It takes less than a minute and is completely free!