PDA

View Full Version : Check if selections in listbox are contiguous



RECrerar
09-03-2009, 03:55 AM
Hi,

I have a multi-select listbox that is populated by the description column (B) value for all rows of data on a particular spreadsheet. The idea is that people can from this select the rows they are interesed in and these are pasted into word as a table.

Currently the user can either:

Select All Rows and the data will be pasted as a linked table
Select any rows they want and the data is pasted as a non-linked table.The latter doesn't link them because if the rows are non-contiguous then a linked table would contain the interveening cells. However it is probably that in most cases the rows that are selected will be contiguous and therefore could easily be pasted as linked tables. The question is: is there an easy way to tell if only contiguous rows in a listbox have been selected?

I imagine I would be able to do something with checking the difference between two consecutive selected list indices, but am wondering is there is a better way.

Hope that makes sense. Robyn

Benzadeus
09-03-2009, 05:40 AM
The latter doesn't link them because if the rows are non-contiguous then a linked table would contain the interveening cells.

Which command do you use to paste/link table? Could you post your code?

I'm wondering if we can code that will paste the whole linked table even if intervalls are not contiguous.

p45cal
09-03-2009, 06:56 AM
A range has a property called Areas, which has a Count property. Around the time you execute your copy command, you should be able to get the count
(myrng.areas.count) of the areas, if it's 1 then it's a single contiguous area.
However, if you're copying, say 3 columns, separated by columns which you're not copying, the result would be 3, or a multiple of 3 areas. If the result in this case was three, it would still be a range of contiguous rows.

If your copying one row at a time, instead, use the Union method to build up a range, then when you've made up the range, count how many areas it has, then copy it in one.

A bit more info would be useful - always several ways to skin a cat.

RECrerar
09-03-2009, 07:15 AM
Hey thanks for the replys. What I forgot to mention (sorry I meant to) is that the code is being writen in word and connecting to Excel not the other way round.

Firstly p45Cal, Thanks for the suggestion. I was actually thinking of checking if the items selected in the list box were next to each other before starting the copy, but your idea is interesting. The problem I am having though is that I need the Word tables to be linked to the Excel worksheet and as far as I can not figure out a way to paste a non-contiguous linked range. For example, say I wanted to copy rows 1 and 3 but not row 2. If the table was not linked, this would be easy, but a linked table would show rows 1:3 in word even if you only select rows 1&3 in the copy. (I have tried this outside of VBA as well). I have heard that I could link individual cells rather than larger ranger, but this seems very tedious for large tables.

Below is the code I am currently using for the linked and the unlinked inports. I have initially separtated out the important bits as I think it is clearer and at the end I have the full code which also contains a fair amount of formatting and so forth.

To note: startCell is a cell that is searched for and contains the word "description"
lsStats is the name of the listbox in question

Currently there are two different options that people can do each with their own code for pasting the table.

I hope this helps to clarify the issue. The code is probably a bit messy and calls a range of smaller subs (which should not directly affect this issue). Also in the full code at the end is my current solution

1: Paste all rows on the sheet as a linked table;
' Copy the whole range
With Wb.ActiveSheet.Range(startcell.Address).CurrentRegion
.Cells(2, 2).Resize(.Rows.count - 1, .Columns.count - 1).Copy
End With

' Paste Linked Table
Selection.PasteExcelTable True, False, True

2: Insert selected rows as a table (not linked)

With Wb.ActiveSheet
numColumns = .Range(startcell.Address).CurrentRegion.Columns.count - 1

' Copy and Paste header row
.Range(startcell.Offset(0, -1), startcell.Offset(0, numColumns - 2)).Copy
Selection.PasteExcelTable False, True, True
' Append Data Rows
For i = 0 To Me.lsStats.ListCount - 1
If Me.lsStats.Selected(i) = True Then
Set startcell = .Cells.Find(Me.lsStats.List(i), lookat:=xlWhole)
.Range(startcell.Offset(0, -1), startcell.Offset(0, numColumns - 2)).Copy
Selection.PasteAppendTable
End If
Next i
End With



The Full Code

Private Sub cbImport_Click()
' Imports the data into Word
' Turn Off Screen Updating to aid speed
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone
Xl.DisplayAlerts = False
' Check input
If Not CheckInput Then Exit Sub
' Connect to Excel
Set Xl = GetObject(, "Excel.Application")
Xl.Visible = False
Xl.Workbooks(txFilename.Text).Activate
Set Wb = Xl.ActiveWorkbook

' Setup the page and the starting position
If obLandscape Then MakeLandscape 'Assumes originally portrait

If Not obCurrentPos Then
msgbox "This option is not yet implemented"
Exit Sub
End If

' Check the Type of inport and create as required
If obFullTable Then

' Insert all the data on the sheet as a table
With Wb.ActiveSheet
' Search for "Description" an then select current region.
Set startcell = .Cells.Find("Description", lookat:=xlWhole)
' Check if the key word was found
If startcell Is Nothing Then
msg = "The text 'Description' could not be found on this spreadsheet" & vbCr
msg = msg & "Functionality to search for a different key word is not yet developed"
msgbox msg
Exit Sub
End If
End With

If chInsertAll Then

' Copy the whole range
With Wb.ActiveSheet.Range(startcell.Address).CurrentRegion
.Cells(2, 2).Resize(.Rows.count - 1, .Columns.count - 1).Copy
End With

' Paste Linked Table
Selection.PasteExcelTable True, False, True
Selection.MoveUp Unit:=wdParagraph, count:=1, Extend:=wdExtend

' Format Linked Table
With Selection.Tables(1)
.AutoFitBehavior (wdAutoFitWindow)
.AutoFitBehavior (wdAutoFitContent)
.Range.Bold = False
.Range.Rows(1).Range.Bold = True
.Rows(1).HeadingFormat = True
End With
MakeManualUpdating
AddTableBorders

Else

' Check that at least one row has been selected
If Me.lsStats.ListIndex = -1 Then
msg = "You have not selected any rows for the table" & vbCr
msg = msg & "Please select at least 1 item from the lower listbox"
msgbox msg, vbExclamation, "Missing Data"
Exit Sub
End If

' msgbox "These Tables Will Not Be Linked", vbOKOnly, "Warning"

' **********************************************
' THIS IS HOW I AM NOW WORKING OUT IF THE LIST BOX SELECTIONS
' ARE CONTGUOUS

' Check if the selection is contiguous
Dim indexArray() As Integer
Dim diff As Integer
Dim nonCont As Boolean
nonCont = False
Dim count As Integer
count = 1
With Me.lsStats
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
ReDim Preserve indexArray(count)
indexArray(count) = i
count = count + 1
End If
Next i
End With
For i = 1 To count
diff = indexArray(i + 1) - indexArray(i)
If diff > 1 Then
nonCont = True
Exit For
End If
Next i

' *************************************************************************
With Wb.ActiveSheet
numColumns = .Range(startcell.Address).CurrentRegion.Columns.count - 1

' Copy and Paste header row
.Range(startcell.Offset(0, -1), startcell.Offset(0, numColumns - 2)).Copy
Selection.PasteExcelTable False, True, True
' Append Data Rows
For i = 0 To Me.lsStats.ListCount - 1
If Me.lsStats.Selected(i) = True Then
Set startcell = .Cells.Find(Me.lsStats.List(i), lookat:=xlWhole)
.Range(startcell.Offset(0, -1), startcell.Offset(0, numColumns - 2)).Copy
Selection.PasteAppendTable
End If
Next i
End With

' Select Table
Selection.MoveUp Unit:=wdParagraph, count:=1, Extend:=wdExtend
Selection.Tables(1).Select

' Format Cells
With Selection.Cells(1)
.WordWrap = True
.FitText = False
End With

' Format Table
With Selection.Tables(1)
.AutoFitBehavior (wdAutoFitWindow)
.AutoFitBehavior (wdAutoFitContent)
.Range.Bold = False
.Range.Rows(1).Range.Bold = True
.Rows(1).HeadingFormat = True
End With
AddTableBorders

End If

ElseIf obTblAndFig Then

' Other stuff

End If

Exit Sub

RECrerar
09-03-2009, 07:46 AM
Oh, I've just realised another issue. Even if the rows of data are contiguous, the total range that should be copied will include the header row, will not be. I can add this seperately in Word, but everytime the table is updated it will go away again, maybe I should just stick with not linked tables.....

p45cal
09-03-2009, 12:03 PM
First let me say I'm not familiar with Word vba, however, with your knowledge on that front we should be able to progress.

Investigation into Word and its handling of links reveals that the links end up as part a single field for each paste operation. Copy a block of cells and you have a single link/field in Word. Copy a single row of 5 cells and you still have a single field/link in Word. These fields don't/won't split so, for example, you can't import them as unformatted text with a link and then create a table afterwards; the field always ends up in one cell of the table in Word, regardless of the numbers of rows/columns in Excel.

Trying to import row by row as a table with its link failed bacause you can't merge the individual tables to one.

So I'm beginning to think that you should treat contiguous rows and non-contiguous row selections in the same way. Worse, I would import cell by cell as plain text (not as an Excel table), each cell having its own link, then create a table by converting the import in Word. This way you could include the headers and updating wouldn't lose them.

You said this would seem very tedious for large tables - Well, depending on how large 'large' can be, it would have to be very large (in the order of tens of thousands of cells) for it to be tedious from a user point of view. As far as coding is concerned it should be a doddle with two, maybe three, nested loops. The code will be the same whethetr you'r copying one row or one thousand. Your Word VBA knowledge is required to insert tabs between each successive paste and a carriage return at the end of each row, converting text to tables etc.

In the end, not having to cater for the absence/presence of contiguity and always having linked data, the updating of which will not upset formatting etc. will have you forgetting about it just microseconds after it's done.

If you want to send me the two (cut down) files privately that's OK, so that I don't have to reproduce the scenarios in Word and Excel. I've sent you a private message with an email address.

RECrerar
09-04-2009, 05:42 AM
Hey, thanks for the advice. I think you are right that linking the individual cells is the way to go. Something has come up at work so I will not be able to look at this today, but I will try and get back to you on Monday, I just wanted to acknowledge the response for now.

Robyn