Previous Topic Next Topic

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
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
Related:

1 response

Answer 1 / 1
Blocked Profile
Updated on Jun 14, 2017 at 05:08 PM
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!

It's kind of fun to do the impossible! -Walter Elias Disney
0

Similar discussions

Comparing Two Excel Sheets and copying like data to third sheet
coz2992 -
TrowaD -

11 responses
VBA Compare 2 sheets and output difference to 3rd sheet
jmah -
TrowaD -

3 responses
Macro to compare 2 sheets and copy differences
ehusar -
AirMaple -

2 responses