Checking and adding values - excel

Question

I am trying to:
open an import file
check for identical values of import file in target file in several columns
if matched, update one cell in target file
if not matched, add another row
This is my code so far (I didn't clean it yet):
Public Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
Sub Import_Macro()
Dim wbData As Workbook
Dim wsData As Worksheet
Dim rngData As Range
Set rngData = Selection
Set wbData = Workbooks(rngData.Parent.Parent.Name)
Set wsData = wbData.Sheets("Fehleranalyse Daten")
'DATA IMPORT
Dim wbImport As Workbook
Dim wsImport As Worksheet
Dim Lastrow_wsData As String
Dim Lastrow_wsData_neu As String
Lastrow_wsData = wsData.Range("A:A").Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Import from file
MyPath = Application.ActiveWorkbook.Path
SetCurrentDirectoryA MyPath
strFileToOpen = Application.GetOpenFilename _
(Title:="Bitte Datei für Fehler-Reporting auswählen", _
FileFilter:="Excel Files *.xls*; *.csv (*.xls*; *.csv),")
'Defining names for Import
Dim rngImport As Range
Set rngImport = Selection
Set wbImport = Workbooks(rngImport.Parent.Parent.Name)
Set wsImport = wbImport.Sheets("Sheet1")
Dim Lastrow_Import As Long
Lastrow_Import = wsImport.Range("A:A").Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim AnmelderImport As Long
Dim AnmelderData As Long
Dim AbteilungImport As Long
Dim AbteilungData As Long
Dim VNrImport As Long
Dim VNrData As Long
Dim AuftragsNrImport As Long
Dim AuftragsNrData As Long
Dim VersuchImport As Long
Dim VersuchData As Long
Dim iCol As Long
Dim colnameData As Variant
Dim colnumImport As Variant
Dim lrData As Long
Dim lcData As Long
Dim lcImport As Long
Dim lrs As Long
Dim r As Long
Dim c As Long
Dim iSOP As Long
Dim j As Long
Dim i As Range
Dim k As Range
Dim n As Long
Dim Check As Variant
Dim arr As Variant
'Creating several array I need to either check for matching or copying
VersuchImport = Application.WorksheetFunction.Match("VERSUCH", wsImport.Range("11:11"), 0) 'Ermittlung der Spalte für Versuch
VersuchData = Application.WorksheetFunction.Match("VERSUCH", wsData.Range("1:1"), 0)
AuftragsNrImport = Application.WorksheetFunction.Match("AUFTRAGSNUMMER", wsImport.Range("11:11"), 0) 'Ermittlung der Spalte für Auftragsnr.
AuftragsNrData = Application.WorksheetFunction.Match("AUFTRAGSNUMMER", wsData.Range("1:1"), 0)
TestzweckImport = Application.WorksheetFunction.Match("TESTZWECK", wsImport.Range("11:11"), 0) 'Ermittlung der Spalte für Testzweck
TestzweckData = Application.WorksheetFunction.Match("TESTZWECK", wsData.Range("1:1"), 0)
StatusImport = Application.WorksheetFunction.Match("AUFTRAGSSTATUS", wsImport.Range("11:11"), 0) 'Ermittlung der Spalte für Status
StatusData = Application.WorksheetFunction.Match("AUFTRAGSSTATUS", wsData.Range("1:1"), 0)
Debug.Print "VersuchImport = " & VersuchImport
Debug.Print "VersuchData = " & VersuchData
Debug.Print "AuftragsNrImport = " & AuftragsNrImport
Debug.Print "AuftragsNrData = " & AuftragsNrData
Debug.Print "TestzweckImport = " & TestzweckImport
Debug.Print "TestzweckData = " & TestzweckData
With wsImport
Check = .Range(.Cells(1, VersuchImport).Address, .Cells(Lastrow_Import, VersuchImport).End(xlUp).Address).Value2 & .Range(.Cells(1, AuftragsNrImport).Address, .Cells(Lastrow_Import, Auftragsnr).End(xlUp).Address).Value2
End With
'I'm creating another array with column names to be copied (bayed on target file)
With wsData
lrData = wsData.Range("A:A").Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lcData = Application.WorksheetFunction.Match("AUFTRAGSSTATUS", .Range("1:1"), 0)
colnameData = Application.Transpose(.Range(.Cells(1, 1), .Cells(1, lcData)).Value)
End With
'The corresponding array in the source file
With wsImport
lcImport = Application.WorksheetFunction.Match("SORTIERUNG", .Range("11:11"), 0)
ReDim colnumImport(lcImport, 1)
For iCol = 1 To lcImport
On Error Resume Next
colnumImport(iCol, 1) = .Rows(11).Find(What:=colnameData(iCol, 1), LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Next iCol
End With
'This section copies all relevant columns and rows if not matched (not cleaned up though)
Dim lcellData As Range
Dim cellAuftragsNrImport As Range
Dim RngAuftragsNrImport As Variant
Dim RngAuftragsNrData As Variant
Dim Status As Long
Dim cellVersuchImport As Range
Dim RngVersuchImport As Variant
Dim RngVersuchData As Variant
Dim cellStatusImport As Range
Dim RngStatusImport As Variant
Dim RngStatusData As Variant
Dim cellTestzweckImport As Range
Dim RngTestzweckImport As Variant
Dim RngTestzweckData As Variant
Dim iZweck As Long
With wsImport
RngAuftragsNrImport = .Range(.Cells(12, AuftragsNrImport).Address, .Cells(Lastrow_Import, AuftragsNrImport).Address).Value2
RngTestzweckImport = .Range(.Cells(12, TestzweckImport).Address, .Cells(Lastrow_Import, TestzweckImport).Address).Value2
RngVersuchImport = .Range(.Cells(12, VersuchImport).Address, .Cells(Lastrow_Import, VersuchImport).Address).Value2
RngStatusImport = .Range(.Cells(12, StatusImport).Address, .Cells(Lastrow_Import, StatusImport).Address).Value2
End With
With wsData
RngAuftragsNrData = .Range(.Cells(3, AuftragsNrData).Address, .Cells(Lastrow_wsData, AuftragsNrData).Address).Value2
RngVersuchData = .Range(.Cells(3, VersuchData).Address, .Cells(Lastrow_wsData, VersuchData).Address).Value2
RngStatusNrData = .Range(.Cells(3, StatusData).Address, .Cells(Lastrow_wsData, StatusData).Address).Value2
RngTestzweckNrData = .Range(.Cells(3, TestzweckData).Address, .Cells(Lastrow_wsData, TestzweckData).Address).Value2
End With
ReDim arr(0)
For iZweck = LBound(RngTestzweckImport, 1) To UBound(RngTestzweckImport, 1)
If RngTestzweckImport(iZweck, 1) = "Entwicklungstest" Then
ReDim Preserve arr(j)
arr(j) = iZweck + 11
j = j + 1
End If
Next iZweck
For Each cellAuftragsNrImport In RngAuftragsNrImport
With wsData.Cells 'RngAuftragsNrData.Cells
Set i = .Find(cellAuftragsNrImport, LookIn:=xlValues, lookat:=xlWhole)
If Not i Is Nothing Then
k = i.Row
Status = .Cells(k, StatusData).Value
If cellStatusImport.Value <> Status Then
cellStatusImport.Copy Destination:=wsData.Cells(i.Row, StatusData)
End If
Else
With wsData
lrData = Lastrow_wsData
For r = LBound(arr) To UBound(arr)
lrData = .Cells(.Rows.Count, 1).End(xlUp).Row
For c = 1 To lcData
.Cells(lrData + 1, c).Value = wsImport.Cells(arr(r), colnumImport(c, 1)).Value
Next c
Next r
End With
End If
End With
Next
End Sub
All names ending with "Import" are from the source file. All names ending with "Data" are for the target file.
I'm trying to:
Check if items of the source file are already part of the target file. That applies only to lines that contain the value "Entwicklungstest" (see arr).
The criteria to be checked are: AuftragsNr (Order ID), Testzweck and Date.
So far my macro only checks for AuftragsNr. Even for that single criteria, my macro doesn't work.
So basically, if the three criteria from above are not met in the target file, a new line should be added. If the criteria are met, the column "Status" must be updated with the value from the source file.
When executing the macro, all it does is add all lines with "Entwicklungstest" after the last row of the target file.