why VBA Run-time error'1004'. you cant paste this here because the copy area and paste area aren't the same size.

Noni · Sep 3, 2022

In Sheet1, A:D has data about this year’s clients and column E has names of last year’s clients. Sheet2 is where new clients' data need to be copied.

With the below code, I'm trying to paste new 2022 clients' data (A:D) to non-filled cells of Sheet2 in columns A:D. the condition is if A2<>E2:E20 then paste A2:D2 into Sheet2 non-filled row.

but I'm getting run-time error 104: "you can't paste this here because the copy area and paste area aren't the same sizes. Select just one cell in the paste area or an area that's the same size, and try pasting again." and the VBA line "ActiveSheet.Paste" is gets yellow highlighted when I click the command button.
I don't understand why.
Sheet2 shows the desired outcome where green highlighted rows are new clients.

VBA Code:

Private Sub CommandButton1_Click()

    c = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    cc = Worksheets("Sheet1").Cells(Rows.Count, 5).End(xlUp).Row

  For j = 1 To c
    For jj = 1 To cc
      
            If Worksheets("Sheet1").Cells(j, 1).Value <> Worksheets("Sheet1").Cells(jj, 5).Value Then

                Worksheets("Sheet1").Range("a" & i & ":d" & i).Copy

                Worksheets("Sheet2").Activate


                b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

                Worksheets("Sheet2").Cells(b + 1, 1).Select

                ActiveSheet.Paste

                Worksheets("Sheet1").Activate

            End If


        Next: Next

    Application.CutCopyMode = False

    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select


End Sub

Worksheets.xlsm

A

B

C

D

E

1

2022 Clients

2022 Data

2022 Data2

2022 Data3

2021 Clients

2

Michael

1234

2345

James

3

Sarah

4321

54

67

Sam

4

Mary

9876

0

34

Peter

5

Rachel

5678

12

45

Shaw

6

Anna

7834

23

0

Sally

7

Monica

2356

45

Michelle

8

Charles

1234

0

Ivona

9

Peter

6543

23

0

Anna

10

Anthony

1234

23

0

Claire

11

Ben

1234

56

34

Ben

12

Elizabeth

6543

0

78

Michael

13

Wong

1276

23456

12

David

14

Sally

9854

23

56

Annaleise

15

Jay

4325

8765

89

Chris

16

Michelle

1265

1256

64

John

17

David

1276

1234

3

Bob

18

Jennifer

1234

8765

56

Anthony

19

Sue

8765

34

78

Sue

20

Ruba

3254

23

9

Robin

21

Henry

9876

78

0

22

Chloe

3245

34567

6

23

Candy

2389

356

5

Sheet1

Worksheets.xlsm

A

B

C

D

1

2022 Clients

2022 Data

2022 Data2

2022 Data3

2

Peter

6543

23

0

3

Sally

9854

23

56

4

Michelle

1265

1256

64

5

Anna

7834

23

0

6

Ben

1234

56

34

7

Michael

1234

2345

8

David

1276

1234

3

9

Anthony

1234

23

0

10

Sue

8765

34

78

11

Sarah

4321

54

67

12

Mary

9876

0

34

13

Rachel

5678

12

45

14

Monica

2356

45

15

Charles

1234

0

16

Elizabeth

6543

0

78

17

Wong

1276

23456

12

18

Jay

4325

8765

89

19

Jennifer

1234

8765

56

20

Ruba

3254

23

9

21

Henry

9876

78

0

22

Chloe

3245

34567

6

23

Candy

2389

356

5

Sheet2

mohadin · Sep 5, 2022

oops
Final revision

VBA Code:

Sub test()
    Dim a, k
    Dim i&
    Dim dic1 As Object
    Dim dic2 As Object
    a = Sheets("sheet1").Cells(1).CurrentRegion
    Set dic1 = CreateObject("scripting.dictionary")
    Set dic2 = CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
        If a(i, 5) <> 0 Then
            If Not dic1.exists(a(i, 5)) Then dic1(a(i, 5)) = dic1(a(i, 5))
        End If
        If Not dic2.exists(a(i, 1)) Then
            dic2.Add a(i, 1), Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4))
        End If
    Next i
    For Each k In dic1.keys
        If Not dic2.exists(k) Then
            dic1.Remove k
        Else
            dic1.Item(k) = dic2.Item(k)
            dic2.Remove k
        End If
    Next
    With Sheets("sheet2")
        Sheets("sheet1").Cells(1, 1).Resize(, 4).Copy .Cells(1, 1)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1) = Application.Index(dic1.items, 0, 0)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1).Interior.Color = 15123099
        .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1) = Application.Index(dic2.items, 0, 0)
        .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1).Interior.Color = 11854022
    End With
End Sub

Noni · Sep 5, 2022

mohadin said:

Any way
This code with coloring

VBA Code:

Sub test()
    Dim a, k
    Dim i&
    Dim dic1 As Object
    Dim dic2 As Object
    a = Sheets("sheet1").Cells(1).CurrentRegion
    Set dic1 = CreateObject("scripting.dictionary")
    Set dic2 = CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
        If a(i, 5) <> 0 Then
            If Not dic1.exists(a(i, 5)) Then dic1(a(i, 5)) = dic1(a(i, 5))
        End If
        If Not dic2.exists(a(i, 1)) Then
            dic2.Add a(i, 1), Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4))
        Else
            dic2.Item(a(i, 1)) = dic2.Item(a(i, 1)) & "," & a(i, 2)
        End If
    Next i
    For Each k In dic1.keys
        If Not dic2.exists(k) Then
            dic1.Remove k
        Else
            dic1.Item(k) = dic2.Item(k)
            dic2.Remove k
        End If
    Next
    With Sheets("sheet2")
        Sheets("sheet1").Cells(1, 1).Resize(, 4).Copy .Cells(1, 1)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1) = Application.Index(dic1.items, 0, 0)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1).Interior.Color = 15123099
        .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1) = Application.Index(dic2.items, 0, 0)
         .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1).Interior.Color = 11854022
    End With
End Sub

@jasonb75 , @mohadin @Alex Blakenburg thank you so much. I ll test the code tomorrow. Much appreciated

Noni · Sep 6, 2022

Noni said:
@jasonb75 , @mohadin @Alex Blakenburg thank you so much. I ll test the code tomorrow. Much appreciated

Above code works perfectly on my example data but when I try on my actual worksheet, I get "Run-Time error 13: type mismatch." and "dic2.Item(a(i, 1)) = dic2.Item(a(i, 1)) & "," & a(i, 2)" gets yellow highlighted

Sample.xlsm

A

B

C

D

E

1

2022 Address

Post_Code

Buildings

Contents

2021 Address

2

215/20B neo Dr VISTA NSW 2098

2153

1874700

166500

8-10 Elizabeth Cres DAH NSW 2456

3

10 Somerset st woy NSW 2098

2640

72287900

5514200

82 Flowerdale Road LIVERL NSW 2000

4

3 Martin ave ALLAM NSW 2100

2100

38307100

1476500

Klemke Cres Woy NSW 2659

5

8-10 Elizabeth Cres DAH NSW 2456

0

206600

167 Rose Street YAGOONA NSW 2199

6

56 folk Road Epp NSW 2123

2121

792900

147200

12 Kurrajong Street SUTHERLAND NSW 2232

7

322 Road MURRUM NSW 2582

2582

13012400

1343300

215/20B neo Dr VISTA NSW 2098

8

Klemke Cres Woy NSW 2659

2659

30014500

3370200

9

10 Somerset st woy NSW 2098

2640

176400

Sheet1

VBA Code:

Sub test()
    Dim a, k
    Dim i&
    Dim dic1 As Object
    Dim dic2 As Object
    a = Sheets("sheet1").Cells(1).CurrentRegion
    Set dic1 = CreateObject("scripting.dictionary")
    Set dic2 = CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
        If a(i, 5) <> 0 Then
            If Not dic1.exists(a(i, 5)) Then dic1(a(i, 5)) = dic1(a(i, 5))
        End If
        If Not dic2.exists(a(i, 1)) Then
            dic2.Add a(i, 1), Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4))
        Else
            dic2.Item(a(i, 1)) = dic2.Item(a(i, 1)) & "," & a(i, 2)
        End If
    Next i
    For Each k In dic1.keys
        If Not dic2.exists(k) Then
            dic1.Remove k
        Else
            dic1.Item(k) = dic2.Item(k)
            dic2.Remove k
        End If
    Next
    With Sheets("sheet2")
        Sheets("sheet1").Cells(1, 1).Resize(, 4).Copy .Cells(1, 1)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1) = Application.Index(dic1.items, 0, 0)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1).Interior.Color = 15123099
        .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1) = Application.Index(dic2.items, 0, 0)
         .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1).Interior.Color = 11854022
    End With
End Sub
Sub Button1_Click()

End Sub

mohadin · Sep 6, 2022

Just tested
Resule

2022 Address	Post_Code	Buildings	Contents
8-10 Elizabeth Cres DAH NSW 2456		0	206600
Klemke Cres Woy NSW 2659	2659	30014500	3370200
215/20B neo Dr VISTA NSW 2098	2153	1874700	166500
10 Somerset st woy NSW 2098	2640	72287900	5514200
3 Martin ave ALLAM NSW 2100	2100	38307100	1476500
56 folk Road Epp NSW 2123	2121	792900	147200
322 Road MURRUM NSW 2582	2582	13012400	1343300

mohadin · Sep 6, 2022

BTW
Can you explain row(3) & row(9)??

Noni · Sep 6, 2022

mohadin said:
BTW
Can you explain row(3) & row(9)??

Same address can appear more than once

Noni · Sep 6, 2022

Noni said:
Same address can appear more than once

Same address can appear multiple times in col A and E

mohadin · Sep 6, 2022

Ok
The code in #21 is the latest version

VBA Code:

Sub test()
    Dim a, k
    Dim i&
    Dim dic1 As Object
    Dim dic2 As Object
    a = Sheets("sheet1").Cells(1).CurrentRegion
    Set dic1 = CreateObject("scripting.dictionary")
    Set dic2 = CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
        If a(i, 5) <> 0 Then
            If Not dic1.exists(a(i, 5)) Then dic1(a(i, 5)) = dic1(a(i, 5))
        End If
        If Not dic2.exists(a(i, 1)) Then
            dic2.Add a(i, 1), Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4))
        End If
    Next i
    For Each k In dic1.keys
        If Not dic2.exists(k) Then
            dic1.Remove k
        Else
            dic1.Item(k) = dic2.Item(k)
            dic2.Remove k
        End If
    Next
    With Sheets("sheet2")
        Sheets("sheet1").Cells(1, 1).Resize(, 4).Copy .Cells(1, 1)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1) = Application.Index(dic1.items, 0, 0)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1).Interior.Color = 15123099
        .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1) = Application.Index(dic2.items, 0, 0)
        .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1).Interior.Color = 11854022
    End With
End Sub

mohadin · Sep 6, 2022

OK Now

Same address can appear more than once in column A

Then Try

VBA Code:

Sub test()
    Dim a, k, xx
    Dim i&, c&
    Dim dic1 As Object
    Dim dic2 As Object
    a = Sheets("sheet1").Cells(1).CurrentRegion
    Set dic1 = CreateObject("scripting.dictionary")
    Set dic2 = CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
        If a(i, 5) <> 0 Then
            If Not dic1.exists(a(i, 5)) Then dic1(a(i, 5)) = dic1(a(i, 5))
        End If
        x = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 4)
        If Not dic2.exists(x) Then
            dic2.Add x, Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4))
        End If
    Next i
    c = 2
    For Each k In dic2.Keys
        c = c + 1
        xx = Split(k, "|")(0)
        If dic1.exists(xx) Then
            dic1.Item(xx) = dic2.Item(k)
            dic2.Remove k
        End If
    Next
    For Each k In dic1.Keys()
        If IsEmpty(dic1.Item(k)) Then dic1.Remove k
    Next
    With Sheets("sheet2")
        Sheets("sheet1").Cells(1, 1).Resize(, 4).Copy .Cells(1, 1)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1) = Application.Index(dic1.Items, 0, 0)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1).Interior.Color = 15123099
        .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1) = Application.Index(dic2.Items, 0, 0)
        .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1).Interior.Color = 11854022
    End With
End Sub

Noni · Sep 9, 2022

mohadin said:

OK Now

Then Try

VBA Code:

Sub test()
    Dim a, k, xx
    Dim i&, c&
    Dim dic1 As Object
    Dim dic2 As Object
    a = Sheets("sheet1").Cells(1).CurrentRegion
    Set dic1 = CreateObject("scripting.dictionary")
    Set dic2 = CreateObject("scripting.dictionary")
    For i = 2 To UBound(a)
        If a(i, 5) <> 0 Then
            If Not dic1.exists(a(i, 5)) Then dic1(a(i, 5)) = dic1(a(i, 5))
        End If
        x = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 4)
        If Not dic2.exists(x) Then
            dic2.Add x, Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4))
        End If
    Next i
    c = 2
    For Each k In dic2.Keys
        c = c + 1
        xx = Split(k, "|")(0)
        If dic1.exists(xx) Then
            dic1.Item(xx) = dic2.Item(k)
            dic2.Remove k
        End If
    Next
    For Each k In dic1.Keys()
        If IsEmpty(dic1.Item(k)) Then dic1.Remove k
    Next
    With Sheets("sheet2")
        Sheets("sheet1").Cells(1, 1).Resize(, 4).Copy .Cells(1, 1)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1) = Application.Index(dic1.Items, 0, 0)
        .Cells(2, 1).Resize(dic1.Count, UBound(a, 2) - 1).Interior.Color = 15123099
        .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1) = Application.Index(dic2.Items, 0, 0)
        .Cells(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1).Interior.Color = 11854022
    End With
End Sub

How above code can be modified to accommodate situation like below:

Peter has 3 properties in 2022, so in Sheet2, 3 rows are copied for Peter which have data about these 3 different properties. Same for rest of orange highlighted ones. (Sheet2 below is the desired result).

In other words, in column A, multiple occurrences of Peter, Anna, Anthony and Ben are not considered duplicate. but in column E, they will be considered as duplicates and will be tested across A:D only once.

WorksheetDummy.xlsm

A

B

C

D

E

1

2022 Clients

2022 Data

2022 Data2

2022 Data3

2021 Clients

2

Michael

1234

2345

James

3

Sarah

4321

54

67

Sam

4

Mary

9876

0

34

Peter

5

Rachel

5678

12

45

Peter

6

Anna

7834

23

0

Shaw

7

Monica

2356

45

Sally

8

Charles

1234

0

Michelle

9

Peter

6543

23

0

Ivona

10

Anthony

1234

23

0

Anna

11

Ben

1234

56

34

Claire

12

Elizabeth

6543

0

78

Ben

13

Wong

1276

23456

12

Ben

14

Sally

9854

23

56

Michael

15

Ben

12

34

3

David

16

Jay

4325

8765

89

Annaleise

17

Anthony

1

2

3

Russell

18

Michelle

1265

1256

64

Chris

19

David

1276

1234

3

Beth

20

Jennifer

1234

8765

56

John

21

Anthony

98

9

7

Bob

22

Sue

8765

34

78

Anthony

23

Ruba

3254

23

9

Anthony

24

Henry

9876

78

0

Josh

25

Chloe

3245

34567

6

Sue

26

Anna

5

6

7

Choung

27

Candy

2389

356

5

Robin

28

Monica

4656

1

2

29

Peter

7

6

8

30

Joe

2345

34

1

31

Peter

56

6

4

Sheet1

WorksheetDummy.xlsm

A

B

C

D

1

2022 Clients

2022 Data

2022 Data2

2022 Data3

2

Peter

6543

23

0

3

Peter

7

6

8

4

Peter

56

6

4

5

Sally

9854

23

56

6

Michelle

1265

1256

64

7

Anna

7834

23

0

8

Anna

5

6

7

9

Ben

1234

56

34

10

Ben

12

34

3

11

Michael

1234

2345

12

David

1276

1234

3

13

Anthony

1234

23

0

14

Anthony

1

2

3

15

Anthony

98

9

7

16

Sue

8765

34

78

17

Sarah

4321

54

67

18

Mary

9876

0

34

19

Rachel

5678

12

45

20

Monica

2356

45

21

Charles

1234

0

22

Elizabeth

6543

0

78

23

Wong

1276

23456

12

24

Jay

4325

8765

89

25

Jennifer

1234

8765

56

26

Ruba

3254

23

9

27

Henry

9876

78

0

28

Chloe

3245

34567

6

29

Candy

2389

356

5

30

Monica

4656

1

2

Sheet2

why VBA Run-time error'1004'. you cant paste this here because the copy area and paste area aren't the same size.

Noni

Board Regular

mohadin

Well-known Member

Excel Facts

Noni

Board Regular

Noni

Board Regular

mohadin

Well-known Member

mohadin

Well-known Member

Noni

Board Regular

Noni

Board Regular

mohadin

Well-known Member

mohadin

Well-known Member

Noni

Board Regular

Similar threads

Forum statistics

Share this page

why VBA Run-time error'1004'. you cant paste this here because the copy area and paste area aren't the same size.

Board Regular

Well-known Member

Excel Facts

Board Regular

Board Regular

Well-known Member

Well-known Member

Board Regular

Board Regular

Well-known Member

Well-known Member

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock