• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Creating a Priority Table from multiple Tables [SOLVED]

So just replace 'rngDest.Resize(rngSource.Rows.Count).Value = rngSource.Value'


with


'rngSource.Copy rngDest'
 
We are getting there, Although now for some reason the priority table copies the links and there clickable but there is no text there As you can see i have made a few changes.. Could seem that now its copying the formatting and the links but not the actual text?


Heres the code as it stands

[pre]
Code: 
Private Sub Worksheet_Activate()

Dim lo As ListObject
Dim lr As ListRow
Dim rngSource As Range
Dim rngDest As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Set lo = [Summary].ListObject
With lo
On Error Resume Next
.DataBodyRange.Rows.Delete
On Error GoTo 0

Set rngSource = [1].ListObject.DataBodyRange
Set rngDest = .HeaderRowRange.Offset(1)
rngSource.Copy rngDest.Resize(rngSource.Rows.Count)

Set rngSource = [2].ListObject.DataBodyRange
Set rngDest = .HeaderRowRange.Offset(1)
rngSource.Copy rngDest.Resize(rngSource.Rows.Count)

Set rngSource = [3].ListObject.DataBodyRange
Set rngDest = .HeaderRowRange.Offset(1)
rngSource.Copy rngDest.Resize(rngSource.Rows.Count)

Set rngSource = [4].ListObject.DataBodyRange
Set rngDest = .HeaderRowRange.Offset(1)
rngSource.Copy rngDest.Resize(rngSource.Rows.Count)

With .Sort
.SortFields.Clear
.SortFields. _
Add Key:=Range("Summary[[#All],[Days In Queue]]"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
[/pre]
 
Well that's engineers for ya...changing the plans without reading the details ;-)


Read the below comments from my original code.


'Copy the first source table into the Summary table.

Set rngSource = [DDA_Priorities].ListObject.DataBodyRange

Set rngDest = .HeaderRowRange.Offset(1)

rngDest.Resize(rngSource.Rows.Count).Value = rngSource.Value


'Copy the other tables in. Note that we can just add a

' listrow, and then copy the data there.

' But we couldn't do that above, because there weren't any

' listrows to add another one to, which is why I used the

' Set rngDest = .HeaderRowRange.Offset(1) line.
 
We're probably going to cross-post. But here goes anyway.


Firstly, I don't understand why you are using the [1] bit in this:

Set rngSource = [1].ListObject.DataBodyRange


[SomeReference] is shorthand for Range("SomeReference"), but you can't have a Range("1") as far as I know, so therefore [1] shouldn't work. Or am I missing something.


Secondly, note that my original code only uses Set rngDest = .HeaderRowRange.Offset(1) when it copies the first table into the empty listobject.


As per my comments, for subsequent pastes, it uses Set rngDest = .ListRows.Add.Range


The reason the first one is different, is you can't add a listrow to a blank table. I.e. if you don't have any listrows, then trying to add some more to some that don't exist will throw an error.
 
Hi Jeffrey sorry yes I forgot to mention, the tables used in the excel use peoples names as a reference for their table so i replace it with a number quickly on the sample file to cover that. Ill make the changes and see what happens.
 
Ok so here is the code again, Seems to do the job however when I go back to the summary page it comes up with a prompt "Delete Entire Sheet Row" when I click to swap back to the summary page. If i press no it reinserts and duplicates the entire table if I press yes it does as it should. Is there anyway to bypass that prompt? Just thinking from an end user point of view if they press no things could get messy.

[pre]
Code: 
Option Explicit

Private Sub Worksheet_Activate()

Dim lo As ListObject
Dim lr As ListRow
Dim rngSource As Range
Dim rngDest As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

Set lo = [Summary].ListObject
With lo
On Error Resume Next
.DataBodyRange.Rows.Delete
On Error GoTo 0

'Copy the first source table into the Summary table.

Set rngSource = [ReferenceA].ListObject.DataBodyRange
Set rngDest = .HeaderRowRange.Offset(1)
rngSource.Copy rngDest.Resize(rngSource.Rows.Count)

Set rngSource = [ReferenceB].ListObject.DataBodyRange
Set rngDest = .ListRows.Add.Range
rngDest.Resize(rngSource.Rows.Count).Value = rngSource.Value

Set rngSource = [ReferenceC].ListObject.DataBodyRange
Set rngDest = .ListRows.Add.Range
rngSource.Copy rngDest.Resize(rngSource.Rows.Count)

Set rngSource = [REferenceD].ListObject.DataBodyRange
Set rngDest = .ListRows.Add.Range
rngDest.Resize(rngSource.Rows.Count).Value = rngSource.Value

With .Sort
.SortFields.Clear
.SortFields. _
Add Key:=Range("Summary[[#All],[Days In Queue]]"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
[/pre]
 
Works perfectly on my system. I don't know why you're getting that error, because my code doesn't delete entire sheet rows. What version of Excel are you using? Do you have any other code in this book that might be causing the issue?


Here's a link to my version:

https://www.dropbox.com/s/js2hkz3fb6s9yw2/Amalgamate%20Tables%20to%20Summary%20Table%2020130622.xlsm
 
Yeah so turns out its because I had the filter one the Description tab to remove any blanks.. I'll turn that off and its fine.. Thanks very much for the help you cannot fathom how much of a help you have been. Pure Genius
 
You must log in or register to reply here.
Back
Top