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

[Noni]

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.

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	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	45	Michelle
8	Charles	1234	0	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	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	45
15	Charles	1234	0	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

 

[jasonb75]

Thanks Mark, but that's not actually the problem. The way that the command actually works, it will loop back and check the first cell last. (If your range is A2:A20 and you start after A5 then it will search A6:A20 followed by A2:A5). The actual problem was that I had a typo in one of the ranges that I missed despite checking over the code numerous times.

@Noni, the corrected code is posted below. After finding the problem it was too late for me to go back and edit my earlier reply.

Option Explicit
Sub CopyClientList()

' Declare variables

Dim ws1 As Worksheet, ws2 As Worksheet
Dim ClientFound As Range, ClientList As Range, NextClient As Range, OldClients As Range
Dim EndOfList As Long, EndOfOld As Long
Dim Clients2022 As Range, Clients2021 As Range

' Set worksheet objects

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

' find last row for each range to be used

EndOfList = ws1.Cells(Rows.Count, 1).End(xlUp).Row
EndOfOld = ws1.Cells(Rows.Count, 5).End(xlUp).Row

' set tables that need to be searched as range objects

Set ClientList = ws1.Range("A2:A" & EndOfList)
Set OldClients = ws1.Range("E2:E" & EndOfOld)

' loop through the names in the 2022 list

For Each NextClient In ClientList

    ' check if client is found in the 2021 list
    
    Set ClientFound = OldClients.Find(NextClient, , xlValues, xlWhole, xlByRows, , False, False, False)
    
        ' assign client to temporary 2021 or 2022 lists based on result of search above
        
        If Not ClientFound Is Nothing Then
            If Clients2021 Is Nothing Then Set Clients2021 = NextClient.Resize(, 4) Else Set Clients2021 = Union(Clients2021, NextClient.Resize(, 4))
        Else
            If Clients2022 Is Nothing Then Set Clients2022 = NextClient.Resize(, 4) Else Set Clients2022 = Union(Clients2022, NextClient.Resize(, 4))
        End If
        
Next NextClient
    
    ' copy the client lists to sheet 2 by year
    
Clients2021.Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Clients2022.Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)

End Sub

 

[MARK858]

Yes, just realised that you were starting the range in E5 (I did edit out my original Idea, after testing but you obviously had already read it)

 

[Noni]

Give this a quick try and see if it works correctly for you, I'm still getting the same error with Peter being copied to the wrong list but can see no reason why it is happening. There is no obvious reason for it to be happening so I'm wondering if it's a problem on my laptop as it has been crashing a lot recently.

Option Explicit
Sub CopyClientList()

' Declare variables

Dim ws1 As Worksheet, ws2 As Worksheet
Dim ClientFound As Range, ClientList As Range, NextClient As Range, OldClients As Range
Dim EndOfList As Long, EndOfOld As Long
Dim Clients2022 As Range, Clients2021 As Range

' Set worksheet objects

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

' find last row for each range to be used

EndOfList = ws1.Cells(Rows.Count, 1).End(xlUp).Row
EndOfOld = ws1.Cells(Rows.Count, 5).End(xlUp).Row

' set tables that need to be searched as range objects

Set ClientList = ws1.Range("A2:A" & EndOfList)
Set OldClients = ws1.Range("E5:E" & EndOfOld)

' loop through the names in the 2022 list

For Each NextClient In ClientList

    ' check if client is found in the 2021 list
   
    Set ClientFound = OldClients.Find(NextClient, , xlValues, xlWhole, xlByRows, , False, False, False)
   
        ' assign client to temporary 2021 or 2022 lists based on result of search above
       
        If Not ClientFound Is Nothing Then
            If Clients2021 Is Nothing Then Set Clients2021 = NextClient.Resize(, 4) Else Set Clients2021 = Union(Clients2021, NextClient.Resize(, 4))
        Else
            If Clients2022 Is Nothing Then Set Clients2022 = NextClient.Resize(, 4) Else Set Clients2022 = Union(Clients2022, NextClient.Resize(, 4))
        End If
Next NextClient
   
    ' copy the client lists to sheet 2 by year
   
Clients2021.Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
Clients2022.Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)

End Sub

I'm getting below result:

WorksheetsV2 - Copy.xlsm
	A	B	C	D
1	2022 Clients	2022 Data	2022 Data2	2022 Data3
2	Michael	1234	1234	2345
3	Anna	7834	23	0
4	Anthony	1234	23	0
5	Ben	1234	56	34
6	Sally	9854	23	56
7	Michelle	1265	1256	64
8	David	1276	1234	3
9	Sue	8765	34	78
10	Sarah	4321	54	67
11	Mary	9876	0	34
12	Rachel	5678	12	45
13	Monica	2356	45	45
14	Charles	1234	0	0
15	Peter	6543	23	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

but the desired result is

WorksheetsV2 - Copy.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	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	45
15	Charles	1234	0	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

because Peter who is an old client in column E comes first it gets copied first in Sheet2. After Peter, Sally is also old client, her data goes second in Sheet2. Then Michelle, Anna, Ben...once all old clients are copied , New client's data gets copied in Sheet2. I hope I'm making sense.

WorksheetsV2 - Copy.xlsm
	A	B	C	D	E
1	2022 Clients	2022 Data	2022 Data2	2022 Data3	2021 Clients
2	Michael	1234	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	45	Michelle
8	Charles	1234	0	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

 

[jasonb75]

That was the error that I said I was getting, the corrected code is in post 11.

 

[Noni]

That was the error that I said I was getting, the corrected code is in post 11.

Thank you @jasonb75! really appreciate it! the order in which old clients are getting copied to the next sheet needs to be changed. with above code I'm getting

cleaning5thSep.xlsm
	A	B	C	D
1	2022 Clients	2022 Data	2022 Data2	2022 Data3
2	Michael	1234	1234	2345
3	Anna	7834	23	0
4	Peter	6543	23	0
5	Anthony	1234	23	0
6	Ben	1234	56	34
7	Sally	9854	23	56
8	Michelle	1265	1256	64
9	David	1276	1234	3
10	Sue	8765	34	78
11	Sarah	4321	54	67
12	Mary	9876	0	34
13	Rachel	5678	12	45
14	Monica	2356	45	45
15	Charles	1234	0	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

but the desired outcome is

cleaning5thSep.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	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	45
15	Charles	1234	0	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

because Peter who is an old client in column E comes first it gets copied first in Sheet2. After Peter, Sally is also old client, her data goes second in Sheet2. Then Michelle, Anna, Ben...once all old clients are copied , New client's data gets copied in Sheet2. I hope I'm making sense. this order is crucial. could you change the code

 

[Alex Blakenburg]

I have probably total misunderstood the requirement but see if this alternative approach does what you need.
It assumes the headings are already in Sheet2 and that apart for the headings there is nothing in Sheet2.

Sub CopyOldNewClients()

    Dim shtOld As Worksheet, shtNew As Worksheet
    Dim rngOld As Range, rngLookup As Range, rngNew As Range
    Dim lrowOld As Long, lrowLookup As Long, lcolNew As Long
    Application.ScreenUpdating = False
    
    Set shtOld = Worksheets("Sheet1")
    Set shtNew = Worksheets("Sheet2")
    
    lrowOld = shtOld.Range("A" & Rows.Count).End(xlUp).Row
    Set rngOld = shtOld.Range("A2:D" & lrowOld)
    lrowLookup = shtOld.Range("E" & Rows.Count).End(xlUp).Row
    Set rngLookup = shtOld.Range("E2:E" & lrowLookup)
    
    
    rngOld.Copy
    shtNew.Range("A2").PasteSpecial
    
    lcolNew = rngOld.Columns.Count + 1
    Set rngNew = shtNew.Range(rngOld.Address).Resize(, lcolNew)
    
    rngNew.Columns(lcolNew).Formula = "=IfError(Match(" & rngNew.Cells(1, 1).Address(0, 1) & "," & rngLookup.Address(external:=True) & ", 0), 999999)"
    rngNew.Columns(lcolNew).Value = rngNew.Columns(lcolNew).Value
    
    Set rngNew = rngNew.Offset(-1).Resize(rngNew.Rows.Count + 1)
    
    shtNew.Sort.SortFields.Clear
    shtNew.Sort.SortFields.Add2 Key:=rngNew.Columns(lcolNew) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange rngNew
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    rngNew.Columns(lcolNew).EntireColumn.Delete
    
    shtNew.Activate
    shtNew.Range("A1").Select
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = False

End Sub

 

[jasonb75]

Sorry, that was my fault entirely. You have been asking for that but I missed it when I was reading your question.

I'm a bit pressed for time today so had to do a quick edit to my original suggestion for 2 buttons (changed it so that it still does all with 1 button). As far as I can see from a quick test it is putting the results in the correct order, although it does take longer than the last one.

Option Explicit
Sub CopyClientList()

Application.ScreenUpdating = False

Dim ws1 As Worksheet, ws2 As Worksheet
Dim ClientFound As Range, ClientList As Range, NextClient As Range, OldClients As Range, NextOldClient
Dim EndOfList As Long, PasteRow As Long, EndOfOld As Long

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

EndOfList = ws1.Cells(Rows.Count, 1).End(xlUp).Row
PasteRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
EndOfOld = ws1.Cells(Rows.Count, 5).End(xlUp).Row

Set ClientList = ws1.Range("A2:A" & EndOfList)
Set OldClients = ws1.Range("E1:E" & EndOfOld)

For Each NextOldClient In OldClients
    
    Set ClientFound = ClientList.Find(NextOldClient, , xlValues, xlWhole, xlByRows, , False, False, False)
    
        If Not ClientFound Is Nothing Then
            ClientFound.Resize(, 4).Copy ws2.Cells(PasteRow, 1)
            PasteRow = PasteRow + 1
        End If
        
Next NextOldClient

For Each NextClient In ClientList
    
    Set ClientFound = OldClients.Find(NextClient, , xlValues, xlWhole, xlByRows, , False, False, False)

        If ClientFound Is Nothing Then
            NextClient.Resize(, 4).Copy ws2.Cells(PasteRow, 1)
            PasteRow = PasteRow + 1
        End If
    
Next NextClient

Application.ScreenUpdating = True


End Sub

@MARK858 I'm going to be away for a few days and won't have my laptop with me, would you be able to assist with any problems that the OP encounters please? I'll check when I can but with my coding (and posting) skills are very limited on my phone. Takes all day to write a simple formula on there

 

[mohadin]

hi
Sorry I'm so late
Try

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(dic1.Count + 2, 1).Resize(dic2.Count, UBound(a, 2) - 1) = Application.Index(dic2.items, 0, 0)
  End With
End Sub

If Ok and need coloring just let me know

 

[MARK858]

I'll check when I can but with my coding (and posting) skills are very limited on my phone. Takes all day to write a simple formula on there

No problem today but will be more of an issue tomorrow as will be at work and will have the same issue as you for 12 hours

 

[mohadin]

Any way
This code with coloring

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