1
votes

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
1

1 Answers

1
votes

You want to loop through a Range, not Value.

Also, you need to qualify your Cells and Rows.Count with With shA, by adding the . as a prefix.

Change:

For Each e In .Cells(2, 1).Resize(Cells(Rows.Count, 2).End(3).Row).Value

To:

For Each e In .Cells(2, 1).Resize(.Cells(.Rows.Count, 2).End(3).Row)