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

N

Noni

Board Regular
Joined
Aug 27, 2022
Messages
63
Office Version
  1. 2021
Platform
  1. Windows
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
ABCDE
12022 Clients2022 Data2022 Data22022 Data32021 Clients
2Michael123412342345James
3Sarah43215467Sam
4Mary9876034Peter
5Rachel56781245Shaw
6Anna7834230Sally
7Monica23564545Michelle
8Charles123400Ivona
9Peter6543230Anna
10Anthony1234230Claire
11Ben12345634Ben
12Elizabeth6543078Michael
13Wong12762345612David
14Sally98542356Annaleise
15Jay4325876589Chris
16Michelle1265125664John
17David127612343Bob
18Jennifer1234876556Anthony
19Sue87653478Sue
20Ruba3254239Robin
21Henry9876780
22Chloe3245345676
23Candy23893565
Sheet1

Worksheets.xlsm
ABCD
12022 Clients2022 Data2022 Data22022 Data3
2Peter6543230
3Sally98542356
4Michelle1265125664
5Anna7834230
6Ben12345634
7Michael123412342345
8David127612343
9Anthony1234230
10Sue87653478
11Sarah43215467
12Mary9876034
13Rachel56781245
14Monica23564545
15Charles123400
16Elizabeth6543078
17Wong12762345612
18Jay4325876589
19Jennifer1234876556
20Ruba3254239
21Henry9876780
22Chloe3245345676
23Candy23893565
Sheet2
 
Sort by date Sort by votes
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
 
Upvote 0

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
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
Click to expand...
@jasonb75 , @mohadin @Alex Blakenburg thank you so much. I ll test the code tomorrow. Much appreciated
 
Upvote 0
Noni said:
@jasonb75 , @mohadin @Alex Blakenburg thank you so much. I ll test the code tomorrow. Much appreciated
Click to expand...
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
ABCDE
12022 Address Post_CodeBuildingsContents2021 Address
2215/20B neo Dr VISTA NSW 2098215318747001665008-10 Elizabeth Cres DAH NSW 2456
310 Somerset st woy NSW 2098264072287900551420082 Flowerdale Road LIVERL NSW 2000
43 Martin ave ALLAM NSW 21002100383071001476500Klemke Cres Woy NSW 2659
58-10 Elizabeth Cres DAH NSW 24560206600167 Rose Street YAGOONA NSW 2199
656 folk Road Epp NSW 2123212179290014720012 Kurrajong Street SUTHERLAND NSW 2232
7322 Road MURRUM NSW 25822582130124001343300215/20B neo Dr VISTA NSW 2098
8Klemke Cres Woy NSW 26592659300145003370200
910 Somerset st woy NSW 20982640176400
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
 
Upvote 0
Just tested
Resule
2022 AddressPost_CodeBuildingsContents
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​
 
Upvote 0
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
 
Upvote 0
OK Now
Same address can appear more than once in column A
Click to expand...
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
 
Upvote 0
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
Click to expand...
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
ABCDE
12022 Clients2022 Data2022 Data22022 Data32021 Clients
2Michael123412342345James
3Sarah43215467Sam
4Mary9876034Peter
5Rachel56781245Peter
6Anna7834230Shaw
7Monica23564545Sally
8Charles123400Michelle
9Peter6543230Ivona
10Anthony1234230Anna
11Ben12345634Claire
12Elizabeth6543078Ben
13Wong12762345612Ben
14Sally98542356Michael
15Ben12343David
16Jay4325876589Annaleise
17Anthony123Russell
18Michelle1265125664Chris
19David127612343Beth
20Jennifer1234876556John
21Anthony9897Bob
22Sue87653478Anthony
23Ruba3254239Anthony
24Henry9876780Josh
25Chloe3245345676Sue
26Anna567Choung
27Candy23893565Robin
28Monica465612
29Peter768
30Joe2345341
31Peter5664
Sheet1

WorksheetDummy.xlsm
ABCD
12022 Clients2022 Data2022 Data22022 Data3
2Peter6543230
3Peter768
4Peter5664
5Sally98542356
6Michelle1265125664
7Anna7834230
8Anna567
9Ben12345634
10Ben12343
11Michael123412342345
12David127612343
13Anthony1234230
14Anthony123
15Anthony9897
16Sue87653478
17Sarah43215467
18Mary9876034
19Rachel56781245
20Monica23564545
21Charles123400
22Elizabeth6543078
23Wong12762345612
24Jay4325876589
25Jennifer1234876556
26Ruba3254239
27Henry9876780
28Chloe3245345676
29Candy23893565
30Monica465612
Sheet2
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
183
NdNoviceHlp
NdNoviceHlp
H
  • Solved
Pasting Error when copying columns
2 3
Replies
26
Views
911
Vogateer
V
WERNER SLABBERT
  • Question Question
Run-time error 70 after code changed
Replies
3
Views
67
RoryA
RoryA
B
  • Question Question
Run-time error 1004 method range of object worksheet railed
Replies
2
Views
52
Joe4
Joe4
N
  • Question Question
Finding the differences then copy and paste code to a new sheet
Replies
1
Views
624
myall_blues
myall_blues

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top