vergelijken van 2 tabladen en een changes summary maken

Beste specialisten,

Ik wil graag in excel een vergelijkingstool maken, maar met de volgende voorwaarde: Bij aanvang vraagt hij om de oudste file en de nieuwste file. En bijv deze in één worksheet zet in het de excel file met de tool

Wat wil ik zien:

Ik wil alle verschillen tussen de oude excel file en de actuele excel file willen zien in een overzicht (ze hebben beide de exact dezelfde kolom indeling)

Onder voorwaarden
Er is een WBS nummer en niet een ''blank'' in kolom A

- Staat er een regel wel in de oude file maar niet in de nieuwe dan moet deze naar de changelog worden gekopieerd met comment erachter: Niet meer aanwezig op huidige lijst

Onder voorwaarden
WBS (Kolom A) en Artikelnummer (Kolom C) is hetzelfde in beide excel files
Dan onderstaand
Is status (kolom I) veranderd t.o.v. een week eerder? Zo ja, kopieer naar change log met een comment erachter: Status changed
Is behoefte datum (Kolom E) eerder dan Lev. Datum(Kolom N)? Zo ja, kopieer naar change log met een comment erachter: Behoefte datum eerder dan Lev. Datum

Daarna mag een gekopieerde regel verwijderd worden.

Normaal gesproken heeft de file +-10.000 regels

Pop up en importeren is gelukt!

Sub Componentenlijst_Oud()

Dim fileDialog As fileDialog
Dim strPathFile As String
Dim strFileName As String
Dim strPath As String
Dim dialogTitle As String
Dim wbSource As Workbook
Dim rngToCopy As Range
Dim rngRow As Range
Dim rngDestin As Range
Dim lngRowsCopied As Long


dialogTitle = "Navigate to and select required file."
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
With fileDialog
.InitialFileName = "C:\Users\User\Documents"
'.InitialFileName = ThisWorkbook.Path & "" 'Alternative to previous line
.AllowMultiSelect = False
.Filters.Clear
.Title = dialogTitle


MsgBox "Selecteer de componentlijst van afgelopen week"
If .Show = False Then
MsgBox "File not selected to import. Process Terminated"
Exit Sub
End If
strPathFile = .SelectedItems(1)
End With

Set wbSource = Workbooks.Open(Filename:=strPathFile)

With wbSource.Worksheets("Component") 'Edit "Sheet1" to required sheet name
Set rngToCopy = .Range(.Cells(1, "A"), .UsedRange.SpecialCells(xlCellTypeLastCell))
For Each rngRow In rngToCopy.Rows
If WorksheetFunction.CountA(rngRow) = 0 Then
rngRow.EntireRow.Hidden = True 'Hides rows with no data
End If
Next rngRow

Set rngDestin = ThisWorkbook.Sheets("Componentenlijst_Oud").Cells(1, "A") 'Edit "Sheet1" to destination sheet name

rngToCopy.SpecialCells(xlCellTypeVisible).Copy Destination:=rngDestin

lngRowsCopied = rngToCopy.Columns(1).SpecialCells(xlCellTypeVisible).Count
MsgBox lngRowsCopied & " rows copied."


.Rows.Hidden = False 'Unhides previously hidden rows

End With

wbSource.Close SaveChanges:=False

Set fileDialog = Nothing
Set rngRow = Nothing
Set rngToCopy = Nothing
Set wbSource = Nothing
Set rngDestin = Nothing

'Oude componentenlijst is geimporteerd nu wordt de meest actuele geimporteerd

'MsgBox "De componentlijst van afgelopen week is gekopieerd, selecteer de meest actuele Componentenlijst"
Call Secondcode

End Sub

Sub Secondcode()

Dim fileDialog As fileDialog
Dim strPathFile As String
Dim strFileName As String
Dim strPath As String
Dim dialogTitle As String
Dim wbSource As Workbook
Dim rngToCopy As Range
Dim rngRow As Range
Dim rngDestin As Range
Dim lngRowsCopied As Long


dialogTitle = "Navigate to and select required file."
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
With fileDialog
.InitialFileName = "C:\Users\User\Documents"
'.InitialFileName = ThisWorkbook.Path & "" 'Alternative to previous line
.AllowMultiSelect = False
.Filters.Clear
.Title = dialogTitle


MsgBox "De componentlijst van afgelopen week is gekopieerd, selecteer de meest actuele Componentenlijst"
If .Show = False Then
MsgBox "File not selected to import. Process Terminated"
Exit Sub
End If
strPathFile = .SelectedItems(1)
End With

Set wbSource = Workbooks.Open(Filename:=strPathFile)

With wbSource.Worksheets("Component") 'Edit "Sheet1" to required sheet name
Set rngToCopy = .Range(.Cells(1, "A"), .UsedRange.SpecialCells(xlCellTypeLastCell))
For Each rngRow In rngToCopy.Rows
If WorksheetFunction.CountA(rngRow) = 0 Then
rngRow.EntireRow.Hidden = True 'Hides rows with no data
End If
Next rngRow

Set rngDestin = ThisWorkbook.Sheets("Componentenlijst_Actueel").Cells(1, "A") 'Edit "Sheet1" to destination sheet name

rngToCopy.SpecialCells(xlCellTypeVisible).Copy Destination:=rngDestin

lngRowsCopied = rngToCopy.Columns(1).SpecialCells(xlCellTypeVisible).Count
MsgBox lngRowsCopied & " rows copied."


.Rows.Hidden = False 'Unhides previously hidden rows

End With

wbSource.Close SaveChanges:=False

Set fileDialog = Nothing
Set rngRow = Nothing
Set rngToCopy = Nothing
Set wbSource = Nothing
Set rngDestin = Nothing

'Oude componentenlijst is geimporteerd nu wordt de meest actuele geimporteerd

MsgBox "De meest actuele componentlijst en die van afgelopen week is gekopieerd"


End Sub

de sleutel A-C is niet uniek, er staan meerdere records daarvan in je gegevens.
De andere kolommen zijn blijkbaar wel gelijk.
Moet er daar dan ook een vergelijking op gebeuren ?

Alvast een start, zie bijlage, waarbij ik de nieuwe componenten als tabblad "componenten (2)" gebruikt heb.
Dat is eventjes gemakkelijker dan een 2e file, maar maakt anders niets uit.

PS. ik hoef geen kopie van de oude gegevens zoals hierboven weergegeven, die file moet heel eventjes geopend worden.

Vergelijking

Hi Cow18!

Dankjewel voor je reactie, ik ben redelijk nieuw met VBA heb wel wat ervaring d.m.v. samenwerking met iemand. maar voor mij gemak deel ik het steeds op in sectoren zoals je in de code van de bijlage kan zien.

Bijgevoegd heb ik 3 documenten 1. de tool tot zover ik gekomen ben, 2. componenten lijst ''oud'' en 3. componentenlijst ''nieuw/actueel''

De vergelijking zou eigenlijk als volgt moeten gebeuren:
WBS nummer + Artikelnummer zijn samen uniek, dit unieke nummer moet met elkaar vergeleken worden op tablad oud en actueel -> Afwijking vermelden in changelog

Wat zijn de mogelijke afwijkingen (deze regel moet gekopieerd worden naar changelog + Comment)


Status is gewijzigd t.o.v. het oude document -> comment Status is gewijzigd

Leverdatum is gewijzigd t.o.v. het oude document -> comment Leverdatum is gewijzigd

Herkomst is gewijzigd t.o.v. het oude document -> comment Herkomst is gewijzigd

behoeft datum is eerder dan leverdatum -> comment Behoefte datum eerder dan Lev. Datum

Staat er een regel wel in de oude file maar niet in de nieuwe dan moet deze naar de changelog worden gekopieerd met comment erachter: Niet meer aanwezig op huidige lijst


Maar omdat het bestand zo groot is 10.000 regels, vraag ik mij af of er misschien eerst nog een filter moet worden gedaan op het project naar keuze, oftewel de macro die ik nu heb geschreven zo houden, zodat je alle documenten kan importeren en dan een extra macro (lees knop) waarbij je het gewenste WBS nummer ingeeft bijvoorbeeld N.00568.xx.xx (de x niet invullen) zodat hij op project filtert en alleen voordat project laat zien wat de wijzigingen zijn. Ik betwijfel namelijk of die door de hele file heen kan lopen om alles te vergelijken zonder vast te lopen.

Sorry als ik je vragen niet goed hebt beantwoord dan zal ik dat alsnog proberen laat maar weten!

Alvast super bedankt voor je hulp!

er is verder gewerkt met de gegevens zoals jouw macros die naar de 2 werkbladen kopieren.
Dan kan je de macro "vergelijkingstool" laten lopen.
Ogenschijnlijk gebeurt er niets, behalve dat onderin, in de statusbalk, er 2 keer een tellertje oploopt tot het aantal rijen die je ingebracht hebt.
Daarna krijg je in "changelog" je gevraagde zaken, laat ons zeggen ongeveer, de finetuning volgt nog.
De 1e 400 rijen, dat zijn rijen waarvan de WBS en artikelnr gelijk zijn, maar waarvan er een 2e record in old voorkomt, die verschillend is kwa behoefte, status of levering.
In een vorige post had ik gevraagd wat ik daarmee moest. Als ik straks in de nieuwe lijst moet vergelijken met de oude lijst, met welke record zou ik dan moeten vergelijken ?
Diegene die meest onderaan staat ????
Dan zijn er nog 3 categoriën, behoefte<lever, gewijzigde status en in oud maar niet in nieuw.

Bekijk het anders eens.