Copying from a pick list- creating duplicates on the final output list

[Pat_The_Bat]

I have some code working right now where there are 2 master lists of documents that may be needed in a file. The user goes through and puts an "x" next to the documents they want.
The code is doing what it is supposed to,... it copies any document with an x next to it, and moves it to the output page, but then when you run the macro again, it starts adding the same documents to the list.
Once a documents was swept in a previous run, it should no longer get added to the list.
The user may hit the command button to run the sub multiple/many times, so it can't keep adding duplicates every time.

This is what I'm running now:

'Then add any documents from Master to the Doc Checklist


With Sheets("Master").Range("B2:B100").SpecialCells(xlConstants)
.Offset(, 1).Copy Sheets("Doc Checklist").Range("C2")
End With
On Error Resume Next
Sheets("Doc Checklist").Range("C2:C100").SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
'Then this section looks for any other documents on the Doc Request sheet and adds them to the the Doc Checklist


With Sheets("Doc Request").Range("B17:B100").SpecialCells(xlConstants)
.Offset(, -1).Copy Sheets("Doc Checklist").Range("C2").End(xlDown)
'The line above this needs to reference range = the next available cell in the column C
End With
On Error Resume Next
Sheets("Doc Checklist").Range("C2:C100").SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0

 

[nardagus]

Ok. As OP had a new question to a code we discussed in the other thread I think it needs to be linked here so people know the story, and I also need to reuse code from the other post.
I hope this is ok.

https://www.mrexcel.com/forum/excel...t-available-cell-column-paste-value-into.html

So we have this code:

Sub LR()

Dim LSTROW As Integer


On Error Resume Next
    Sheets("Doc Checklist").Range("C2:C100").SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0


With Sheets("Doc Request").Range("B2:B100").SpecialCells(xlConstants)
    .Offset(, -1).Copy
End With


With Worksheets("Doc Checklist")
    LSTROW = .Range("C" & .rows.Count).End(xlUp).row + 1
    
    'fill next available cell with a new data
    .Range("C" & LSTROW).PasteSpecial xlPasteAll
End With


End Sub

@Pat_The_Bat

You wanted to mark already copied data in "Doc Request" so macro wouldn't copy it again. I don't know how your excel looks like, but...
Is it possible to add another column to your source sheet? We could place some mark there, then macro would check in that column if it can copy rows or not.

You also asked about clearing a sheet. I assume "Doc Checklist"?

 

[Pat_The_Bat]

I was going down the exact same road. I was thinking, as the macro copies the list to paste into Doc Checklist, it would place an "x" in column Z (26).
But then the code needs to change to only copy documents that have an "x" in column B, But Don't have an "x" in column Z.

 

[nardagus]

Try this code then:

Sub LR()

Dim LSTROW As Integer
Dim srcchk As String 'variable to find row range to analyze column Z for marks
Dim cprange As String 'variable to find those rows which haven't been already copied


'remove rows with empty cells in column C
On Error Resume Next
    Sheets("Doc Checklist").Range("C2:C100").SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0




With Sheets("Doc Request")
    'based on column C we need to find row range to search for mark in column Z. We will return address for copy
    srcchk = .Range("B2:B100").SpecialCells(xlConstants).Offset(, 24).Address
    
    'based on address from srcchk we determine address range of blank cells
    On Error GoTo err_msg
    cprange = .Range(srcchk).SpecialCells(xlBlanks).Address
    
    'using address from cprange we move selection left by 25 columns and copy data
    .Range(cprange).Offset(, -25).Copy
End With




With Worksheets("Doc Checklist")
    LSTROW = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    
    'fill next available cell with a new data
    .Range("C" & LSTROW).PasteSpecial xlPasteAll
End With


'once again, using cprange we mark rows which have been copied to "Doc Checklist"
With Sheets("Doc Request")
    .Range(cprange).Value = "x"
End With
GoTo end_sub


err_msg:
MsgBox "There no rows found to copy."


end_sub:


End Sub

It will check for nonblank cells in whole range of column B, and retrieve a new range where it found nonblanks. Then using a new range it will check column Z but for blanks this time, again retrieving a range for blank only. Then this new range is used to copy data to another sheet and then mark rows as copied.
I.e. we analyze B2:B100 for nonblank. Excel found range B2:B20. So for blank cells checking in column Z it will take only rows 2 through 20. Excel found blank cells in Z15:Z20. So it will copy A15:A20, and then mark Z15:Z20 as copied.

I hope it's clear.

 

[Pat_The_Bat]

Try this code then:

Sub LR()

Dim LSTROW As Integer
Dim srcchk As String 'variable to find row range to analyze column Z for marks
Dim cprange As String 'variable to find those rows which haven't been already copied


'remove rows with empty cells in column C
On Error Resume Next
    Sheets("Doc Checklist").Range("C2:C100").SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0




With Sheets("Doc Request")
    'based on column C we need to find row range to search for mark in column Z. We will return address for copy
    srcchk = .Range("B2:B100").SpecialCells(xlConstants).Offset(, 24).Address
    
    'based on address from srcchk we determine address range of blank cells
    On Error GoTo err_msg
    cprange = .Range(srcchk).SpecialCells(xlBlanks).Address
    
    'using address from cprange we move selection left by 25 columns and copy data
    .Range(cprange).Offset(, -25).Copy
End With




With Worksheets("Doc Checklist")
    LSTROW = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    
    'fill next available cell with a new data
    .Range("C" & LSTROW).PasteSpecial xlPasteAll
End With


'once again, using cprange we mark rows which have been copied to "Doc Checklist"
With Sheets("Doc Request")
    .Range(cprange).Value = "x"
End With
GoTo end_sub


err_msg:
MsgBox "There no rows found to copy."


end_sub:


End Sub

It will check for nonblank cells in whole range of column B, and retrieve a new range where it found nonblanks. Then using a new range it will check column Z but for blanks this time, again retrieving a range for blank only. Then this new range is used to copy data to another sheet and then mark rows as copied.
I.e. we analyze B2:B100 for nonblank. Excel found range B2:B20. So for blank cells checking in column Z it will take only rows 2 through 20. Excel found blank cells in Z15:Z20. So it will copy A15:A20, and then mark Z15:Z20 as copied.

I hope it's clear.

I'm with you. It's the exact approach I was thinking. When I step through it, I get Run-Time Error '1004' "No Cells Were Found" at this line

srcchk = .Range("B2:B100").SpecialCells(xlConstants).Offset(, 24).Address

Any thoughts? I'm trying to figure it out.

 

[Pat_The_Bat]

Now I'm also getting a compile error : Label not defined

the line of code that triggers it is this:
On Error GoTo err_msg

 

[nardagus]

Show me your code. It will be easier to debug.

 

[Pat_The_Bat]

Show me your code. It will be easier to debug.

Sub LR()


Dim LSTROW As Integer
Dim srcchk As String 'variable to find row range to analyze column Z for marks
Dim cprange As String 'variable to find those rows which haven't been already copied




'remove rows with empty cells in column C
On Error Resume Next
Sheets("Doc Checklist").Range("C2:C100").SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0








With Sheets("Doc Request")
'based on column C we need to find row range to search for mark in column Z. We will return address for copy
srcchk = .Range("B2:B100").SpecialCells(xlConstants).Offset(, 24).Address

'based on address from srcchk we determine address range of blank cells
On Error GoTo err_msg
cprange = .Range(srcchk).SpecialCells(xlBlanks).Address

'using address from cprange we move selection left by 25 columns and copy data
.Range(cprange).Offset(, -25).Copy
End With




End Sub

 

[nardagus]

I'm with you. It's the exact approach I was thinking. When I step through it, I get Run-Time Error '1004' "No Cells Were Found" at this line

srcchk = .Range("B2:B100").SpecialCells(xlConstants).Offset(, 24).Address

Any thoughts? I'm trying to figure it out.

Are there any nonempty cells in B2:B100? If this range has no values it will give an error. I added a handling of it. Check code at the end of the post.

Now I'm also getting a compile error : Label not defined

the line of code that triggers it is this:
On Error GoTo err_msg

Your macro is incomplete comparing to the one I have posted.

This was my whole code. Mind you might scroll inner frame to check whole code.

Sub LR()


Dim LSTROW As Integer
Dim srcchk As String 'variable to find row range to analyze column Z for marks
Dim cprange As String 'variable to find those rows which haven't been already copied




'remove rows with empty cells in column C
On Error Resume Next
    Sheets("Doc Checklist").Range("C2:C100").SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0


With Sheets("Doc Request")
    On Error GoTo err_msg
    'based on column C we need to find row range to search for mark in column Z. We will return address for copy
    srcchk = .Range("B2:B100").SpecialCells(xlConstants).Offset(, 24).Address
    
    'based on address from srcchk we determine address range of blank cells
    On Error GoTo err_msg
    cprange = .Range(srcchk).SpecialCells(xlBlanks).Address
    
    'using address from cprange we move selection left by 25 columns and copy data
    .Range(cprange).Offset(, -25).Copy
End With


With Worksheets("Doc Checklist")
    LSTROW = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    
    'fill next available cell with a new data
    .Range("C" & LSTROW).PasteSpecial xlPasteAll
End With


'once again, using cprange we mark rows which have been copied to "Doc Checklist"
With Sheets("Doc Request")
    .Range(cprange).Value = "x"
End With
GoTo end_sub


err_msg:
MsgBox "There no rows found to copy."


end_sub:


End Sub

 

[Pat_The_Bat]

Are there any nonempty cells in B2:B100? If this range has no values it will give an error. I added a handling of it. Check code at the end of the post.




Your macro is incomplete comparing to the one I have posted.

This was my whole code. Mind you might scroll inner frame to check whole code.

Sub LR()


Dim LSTROW As Integer
Dim srcchk As String 'variable to find row range to analyze column Z for marks
Dim cprange As String 'variable to find those rows which haven't been already copied




'remove rows with empty cells in column C
On Error Resume Next
    Sheets("Doc Checklist").Range("C2:C100").SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0


With Sheets("Doc Request")
    On Error GoTo err_msg
    'based on column C we need to find row range to search for mark in column Z. We will return address for copy
    srcchk = .Range("B2:B100").SpecialCells(xlConstants).Offset(, 24).Address
    
    'based on address from srcchk we determine address range of blank cells
    On Error GoTo err_msg
    cprange = .Range(srcchk).SpecialCells(xlBlanks).Address
    
    'using address from cprange we move selection left by 25 columns and copy data
    .Range(cprange).Offset(, -25).Copy
End With


With Worksheets("Doc Checklist")
    LSTROW = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    
    'fill next available cell with a new data
    .Range("C" & LSTROW).PasteSpecial xlPasteAll
End With


'once again, using cprange we mark rows which have been copied to "Doc Checklist"
With Sheets("Doc Request")
    .Range(cprange).Value = "x"
End With
GoTo end_sub


err_msg:
MsgBox "There no rows found to copy."


end_sub:


End Sub

So timely. I'm taking a class on VBA and I'm sitting here watching a lecture on error handling! I probably didn't scroll in the inner frame to get all that code the first time. Trying again. Will report back. Thank you!
Thank you.