Preserving cell validation on worksheets post data merging

[jbrady]

I am trying to merge data from 2 worksheets into a 3rd worksheet within the same workbook, and I need this 'merge' to happen automatically when a user opens the workbook.

Specifically:
The first worksheet is called "AUTO-ASSIGNED" and there are 12 columns (A to L) that contain data. The row count will vary all the time so there is nothing fixed about it.

The second worksheet is called "SELF-ASSIGNED" and it also has 12 columns (A to L) that contain data.

I copy and paste the data on both of these worksheets into a 3rd worksheet within the same workbook called "LEAD SUMMARY" starting in cell A2, and list/sort the data based on date (column D on both sheets contains a key date).

Row 1 of each of the worksheets contains the column titles:
Title; Sname; Fname; Date Received; Date Allocated; Product Type; Product Quantity; City; Region; Ad Source; Media Type; Assigned To

For each iteration of this action the 'copied and pasted' data is added into the summary sheet while preserving the data already present from the first iteration. And so on with a third and fourth iteration.

I clear the AUTO-ASSIGNED and SELF-ASSIGNEDworksheets after the Leads Summary sheet has the data on it with each iteration, so as to remove data duplication within the worksheet.

I got help from a good guy in San Francisco who helped me get this far....but there is still one stumbing block (I didn't think I should bother him with it as he had already been very helpful).

I have cell validation on the AUTO-ASSIGNED and SELF-ASSIGNED and this gets wiped on the first iteration, so I need to find a way to correct this so validation remains.

So far, I've put the following code in the workbook:

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim NextRow As Long, DestSheet As Worksheet
Set DestSheet = Worksheets("LEAD SUMMARY")
With DestSheet
NextRow = .Cells.Find(What:="*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
End With
With Worksheets("AUTO-ASSIGNED").Range("A1").CurrentRegion
If .Rows.Count > 1 Then .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Cut DestSheet.Cells(NextRow, 1)
End With
With DestSheet
NextRow = .Cells.Find(What:="*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
End With
With Worksheets("SELF-ASSIGNED").Range("A1").CurrentRegion
If .Rows.Count > 1 Then .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Cut DestSheet.Cells(NextRow, 1)
End With
With DestSheet
If WorksheetFunction.CountA(.Columns(4)) > 1 Then .Range("A1").CurrentRegion.Sort Key1:=.Range("D2"), Order1:=xlAscending, Header:=xlYes
End With
Set DestSheet = Nothing
Application.ScreenUpdating = True
End Sub

I am using Excel 2003.

Any direction anyone could provide would be much appreciated.

Many thanks and please!

 

[Brianwarnock]

As stated in help any validation is lost for cells involved in copy type operations, however the validation will still exist for the rows below the data entered and cut/pasted, thus it would be possible for you to write code to copy and .PasteSpecial Paste:=xlPasteValidation the validation back for those rows.

Brian

 

[jbrady]

Thanks Brian, I was unsure of a work around, but will try what you've suggested.

Many thanks, J

 

[Brianwarnock]

I hope you don't mind but with a bit of time on my hands and not sure of your expertise I had a go at this and my attempt is listed below. The changes are indented so that you can more easily spot them.
One think I did learn was that Application.cutcopymode = False does not work for PasteSpecial, atleast I could not fathom it.

Brian

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim NextRow As Long, DestSheet As Worksheet
    Dim rc As Long, cc As Long
Set DestSheet = Worksheets("LEAD SUMMARY")

With DestSheet
NextRow = .Cells.Find(What:="*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
End With
With Worksheets("AUTO-ASSIGNED").Range("A1").CurrentRegion
    rc = .Rows.Count
    cc = .Columns.Count
    If .Rows.Count > 1 Then
    .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Cut DestSheet.Cells(NextRow, 1)
    .Offset(rc).Resize(rc - 1, cc).Copy
    .Offset(1).PasteSpecial Paste:=xlPasteValidation
    End If
End With
With DestSheet
NextRow = .Cells.Find(What:="*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
End With
With Worksheets("SELF-ASSIGNED").Range("A1").CurrentRegion
    rc = .Rows.Count
    cc = .Columns.Count
    If .Rows.Count > 1 Then
    .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).Cut DestSheet.Cells(NextRow, 1)
    .Offset(rc).Resize(rc - 1, cc).Copy
    .Offset(1).PasteSpecial Paste:=xlPasteValidation
    End If
End With
With DestSheet
If WorksheetFunction.CountA(.Columns(4)) > 1 Then .Range("A1").CurrentRegion.Sort Key1:=.Range("D2"), Order1:=xlAscending, Header:=xlYes
End With
Set DestSheet = Nothing
Application.ScreenUpdating = True

End Sub