I have got a macro that should compare two columns in two different cells. It worked at first when I tested it. (Please ignore the german notes)
Both worksheets have 8 columns but I just want to compare the first ones with each other. I have marked the line where I get a
run time error 424
Can anyone help?
'Objekte festlegen
Dim j As Integer
Dim d1 As Object
Dim d2 As Object
Dim d3 As Object
Dim e As Range
Dim shA As Worksheet
Dim shB As Worksheet
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
Set shA = Worksheets(Format(Date, "dd.mm.yyyy"))
Set shB = Worksheets(ActiveSheet.Index - 1)
'Füge ICM Nummern des alten Tabellenblattes Objekten zu
With shB
For Each e In .Cells(2, 1).Resize(Cells(Rows.Count, 1).End(3).Row).Value
d1(e) = True
d2(e) = True
Next e
End With
'Neue und alte ICM Nummern bestimmen
With shA
For Each e In .Cells(2, 1).Resize(Cells(Rows.Count, 2).End(3).Row).Value
If (d2(e)) * (d1.exists(e)) Then d1.Remove e
If Not d2(e) Then d3(e) = True
Next e
'Bestimme Anzahl zu erstellender Zeilen If d1.Count > d3.Count Then Set j = d1.Count Else: Set j = d3.Count End If
'Füge Zellen ein
Range("1:1").Resize(j).Insert Shift:=xlDown, Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'Objekte transponieren und einfügen in aktuelles Tabellenblatte unter ICM Abzug
On Error Resume Next
.Cells(1, 10).Resize(d1.Count) = Application.Transpose(d1.keys)
.Cells(1, 11).Resize(d3.Count) = Application.Transpose(d3.keys)
On Error GoTo 0
End With