Fill Listview form 3 identical sheets (with same headers)

[djemy1975]

Dear friends,

Is it possible to populate a listview from three sheets with the same headers in one workbook0Currently I am using this code:

'Populate Listview Dim ws As Worksheet
Dim lngRow As Long
Dim lvwItem As listItem
Dim lngEndCol As Long
Dim lngCol As Long
Dim lngEndRow As Long
Dim lngItemIndex As Long
Dim blnHeaders() As Boolean

Set ws = Array("Basic to Sustain", "Specific to sustain", "Improve-performance")
lngEndCol = ws.Range("A1").End(xlToRight).Column
lngEndRow = ws.Range("A1").End(xlDown).Row

lngRow = 1
With ListView1
.View = lvwReport
ReDim blnHeaders(1 To lngEndCol)
For lngCol = 1 To lngEndCol
If Application.WorksheetFunction.CountA(ws.Range(ws.Cells(1, lngCol), ws.Cells(lngEndRow, lngCol))) > 1 Then
.ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Value, ws.Columns(lngCol).ColumnWidth * 10
blnHeaders(lngCol) = True
End If
Next
For lngRow = 2 To lngEndRow
lngCol = 1
lngItemIndex = 0
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, lngCol).Value)
For lngCol = 2 To lngEndCol
If blnHeaders(lngCol) Then
lngItemIndex = lngItemIndex + 1
lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value 'Adds Value from Current Row and Column 1
End If
Next
Next
End With

But it seems not working and gives "run time error 424-object required"

Here is a screenshot as well as my sample data attached:
23256

[Paul_Hossler]

'Set' is for Objects, not arrays of Strings

Look at the ------------------ lines

Loop through Worksheets ('ws') and add items to the listview





Call CondFormat
Dim ws As Worksheet
Dim lngRow As Long
Dim lvwItem As listItem
Dim lngEndCol As Long
Dim lngCol As Long
Dim lngEndRow As Long
Dim lngItemIndex As Long
Dim blnHeaders() As Boolean

'------------------------------------------------------------------------
Dim vSheets As Variant, vSheet As Variant

vSheets = Array("Basic to Sustain", "Specific to sustain", "Improve-performance")

For Each vSheet In vSheets
Set ws = Worksheets(vSheet)
'------------------------------------------------------------------------


lngEndCol = ws.Range("A1").End(xlToRight).Column
lngEndRow = ws.Range("A1").End(xlDown).Row

lngRow = 1
With ListView1
.View = lvwReport
ReDim blnHeaders(1 To lngEndCol)
For lngCol = 1 To lngEndCol
If Application.WorksheetFunction.CountA(ws.Range(ws.Cells(1, lngCol), ws.Cells(lngEndRow, lngCol))) > 1 Then
.ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Value, ws.Columns(lngCol).ColumnWidth * 10
blnHeaders(lngCol) = True
End If
Next
For lngRow = 2 To lngEndRow
lngCol = 1
lngItemIndex = 0
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, lngCol).Value)
For lngCol = 2 To lngEndCol
If blnHeaders(lngCol) Then
lngItemIndex = lngItemIndex + 1
lvwItem.SubItems(lngItemIndex) = ws.Cells(lngRow, lngCol).Value 'Adds Value from Current Row and Column 1
End If
Next
Next
End With
'------------------------------------------------------------------------
Next
'------------------------------------------------------------------------

End Sub

[djemy1975]

The code is working ,but not 100% as some data are not in the right column and column headers are repeated three times .Result is shown herewith in this screenshot.Could you tell me where is the problem:

23260

What I want to do is to load all data from the three sheets then filter them using comboboxes and a textbox.

Best regards,

[Paul_Hossler]

Try these

You were adding column headers in at lest two places so that's probably why they were doubled




Private Sub UserForm_Initialize()

Call Create_Lists
Call CondFormat

Dim ws As Worksheet
Dim lngRow As Long
Dim lvwItem As listItem
Dim lngCol As Long
Dim rSheet As Range

With ListView1
.View = lvwReport
.ColumnHeaders.Clear

Set ws = Worksheets("Basic to Sustain")
Set rSheet = ws.Cells(1, 1).CurrentRegion

rSheet.EntireColumn.AutoFit

For lngCol = 1 To rSheet.Columns.Count
.ColumnHeaders.Add , , ws.Cells(1, lngCol).Value, ws.Columns(lngCol).ColumnWidth * 10
Next lngCol


' LV_AutoSizeColumn ListView1

For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow


Set ws = Worksheets("Specific to sustain")
Set rSheet = ws.Cells(1, 1).CurrentRegion
For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow


Set ws = Worksheets("Improve-performance")
Set rSheet = ws.Cells(1, 1).CurrentRegion
For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow
End With

End Sub




Private Sub UserForm_Activate()
Dim C As Long
Dim Wks As Worksheet
Dim SheetsFound()
With ListView1
.Gridlines = True
.View = lvwReport
.HideSelection = False
.FullRowSelect = True
.HotTracking = True
.HoverSelection = False
' .ColumnHeaders.Add Text:="Sheet", Width:=50 'Delete this
'********* .ColumnHeaders.Add Text:="Row", Width:=64
End With
Set Wks = Sheets(1)
'For C = 1 To 13
'******* For C = 1 To 60
'******* ListView1.ColumnHeaders.Add Text:=Wks.Cells(1, C).Text
'******* ComboBox1.AddItem Wks.Cells(1, C).Text
' Next C
ReDim SheetsFound(0)
For Each Wks In ActiveWorkbook.Sheets
If Not Wks.Name = "Lists" Then
SheetsFound(UBound(SheetsFound)) = Wks.Name
ReDim Preserve SheetsFound(UBound(SheetsFound) + 1)
End If
Next Wks
ReDim Preserve SheetsFound(UBound(SheetsFound) - 1)
SheetsFound = Array("Basic to Sustain", "Specific to sustain", "Improve-performance")
Me.ComboBox6.List = SheetsFound ' WorksheetFunction.Transpose(SheetsFound)
'Me.ComboBox6.List = WorksheetFunction.Transpose(SheetsFound)
ChartNum = 1
Call CondFormat
End Sub

[djemy1975]

I will test it and be back soon

[djemy1975]

Try these

You were adding column headers in at lest two places so that's probably why they were doubled




Private Sub UserForm_Initialize()

Call Create_Lists
Call CondFormat

Dim ws As Worksheet
Dim lngRow As Long
Dim lvwItem As listItem
Dim lngCol As Long
Dim rSheet As Range

With ListView1
.View = lvwReport
.ColumnHeaders.Clear

Set ws = Worksheets("Basic to Sustain")
Set rSheet = ws.Cells(1, 1).CurrentRegion

rSheet.EntireColumn.AutoFit

For lngCol = 1 To rSheet.Columns.Count
.ColumnHeaders.Add , , ws.Cells(1, lngCol).Value, ws.Columns(lngCol).ColumnWidth * 10
Next lngCol


' LV_AutoSizeColumn ListView1

For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow


Set ws = Worksheets("Specific to sustain")
Set rSheet = ws.Cells(1, 1).CurrentRegion
For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow


Set ws = Worksheets("Improve-performance")
Set rSheet = ws.Cells(1, 1).CurrentRegion
For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow
End With

End Sub




Private Sub UserForm_Activate()
Dim C As Long
Dim Wks As Worksheet
Dim SheetsFound()
With ListView1
.Gridlines = True
.View = lvwReport
.HideSelection = False
.FullRowSelect = True
.HotTracking = True
.HoverSelection = False
' .ColumnHeaders.Add Text:="Sheet", Width:=50 'Delete this
'********* .ColumnHeaders.Add Text:="Row", Width:=64
End With
Set Wks = Sheets(1)
'For C = 1 To 13
'******* For C = 1 To 60
'******* ListView1.ColumnHeaders.Add Text:=Wks.Cells(1, C).Text
'******* ComboBox1.AddItem Wks.Cells(1, C).Text
' Next C
ReDim SheetsFound(0)
For Each Wks In ActiveWorkbook.Sheets
If Not Wks.Name = "Lists" Then
SheetsFound(UBound(SheetsFound)) = Wks.Name
ReDim Preserve SheetsFound(UBound(SheetsFound) + 1)
End If
Next Wks
ReDim Preserve SheetsFound(UBound(SheetsFound) - 1)
SheetsFound = Array("Basic to Sustain", "Specific to sustain", "Improve-performance")
Me.ComboBox6.List = SheetsFound ' WorksheetFunction.Transpose(SheetsFound)
'Me.ComboBox6.List = WorksheetFunction.Transpose(SheetsFound)
ChartNum = 1
Call CondFormat
End Sub


It is so kind frm you for your patience on me as I am asking too much questions.It is working but LISTVIEWCLICK sub is giving error now:

23262

Also search button is no longer working .

Please guide me to get the solution.

Best regards,

[Paul_Hossler]

23264

I got rid of UserForm_Activate since you were doing some things twice

The LV_AutoSizeColumn is commented out since I didn't like the results. I don't think you need it







Private Sub UserForm_Initialize()

Call Create_Lists
ChartNum = 1
Call CondFormat

Dim ws As Worksheet
Dim lngRow As Long
Dim lvwItem As listItem
Dim lngCol As Long
Dim rSheet As Range

With ComboBox6
.List = Array("Basic to Sustain", "Specific to sustain", "Improve-performance")
End With

With ComboBox1
.List = Application.WorksheetFunction.Transpose(Worksheets("Basic to Sustain").Cells(1, 1).CurrentRegion.Rows(1))
End With



With ListView1
.View = lvwReport
.Gridlines = True
.HideSelection = False
.FullRowSelect = True
.HotTracking = True
.HoverSelection = False
.ColumnHeaders.Clear

Set ws = Worksheets("Basic to Sustain")
Set rSheet = ws.Cells(1, 1).CurrentRegion

rSheet.EntireColumn.AutoFit

For lngCol = 1 To rSheet.Columns.Count
.ColumnHeaders.Add , , ws.Cells(1, lngCol).Value, ws.Columns(lngCol).ColumnWidth * 10
Next lngCol


' LV_AutoSizeColumn ListView1

For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow
Set ws = Worksheets("Specific to sustain")
Set rSheet = ws.Cells(1, 1).CurrentRegion
For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow
Set ws = Worksheets("Improve-performance")
Set rSheet = ws.Cells(1, 1).CurrentRegion
For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow
End With

End Sub

[djemy1975]

It's a good idea ,but there still two problems:

1- filter is working but columns do not conform with data
2- Private Sub ListView1_Click() gives error"Index out of bounds"

23266

Thank you for your replies.

[djemy1975]

Is there any solution for these problems? as the next step is to edit data via this userform.

[djemy1975]

23264

I got rid of UserForm_Activate since you were doing some things twice

The LV_AutoSizeColumn is commented out since I didn't like the results. I don't think you need it







Private Sub UserForm_Initialize()

Call Create_Lists
ChartNum = 1
Call CondFormat

Dim ws As Worksheet
Dim lngRow As Long
Dim lvwItem As listItem
Dim lngCol As Long
Dim rSheet As Range

With ComboBox6
.List = Array("Basic to Sustain", "Specific to sustain", "Improve-performance")
End With

With ComboBox1
.List = Application.WorksheetFunction.Transpose(Worksheets("Basic to Sustain").Cells(1, 1).CurrentRegion.Rows(1))
End With



With ListView1
.View = lvwReport
.Gridlines = True
.HideSelection = False
.FullRowSelect = True
.HotTracking = True
.HoverSelection = False
.ColumnHeaders.Clear

Set ws = Worksheets("Basic to Sustain")
Set rSheet = ws.Cells(1, 1).CurrentRegion

rSheet.EntireColumn.AutoFit

For lngCol = 1 To rSheet.Columns.Count
.ColumnHeaders.Add , , ws.Cells(1, lngCol).Value, ws.Columns(lngCol).ColumnWidth * 10
Next lngCol


' LV_AutoSizeColumn ListView1

For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow
Set ws = Worksheets("Specific to sustain")
Set rSheet = ws.Cells(1, 1).CurrentRegion
For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow
Set ws = Worksheets("Improve-performance")
Set rSheet = ws.Cells(1, 1).CurrentRegion
For lngRow = 2 To rSheet.Rows.Count
Set lvwItem = .ListItems.Add(, , ws.Cells(lngRow, 1).Value)
For lngCol = 2 To rSheet.Columns.Count
lvwItem.ListSubItems.Add , , ws.Cells(lngRow, lngCol).Value
Next lngCol
Next lngRow
End With

End Sub


Dear Mr Paul,

After two days of trial and error ,I have been able to overcome both problems.This of course based on your help.Would you please try to help me again to figure out how to edit data via textboxes and save modifications into the appropriate sheet if it is possible.Here is a screenshot of the result.
- How about using up/down arrows to navigate in listview and display rows content into textboxes instead of the mouse?
23272

Best regards,

[Paul_Hossler]

I don't think you can edit in the ListView if that's what you were looking to do:

https://stackoverflow.com/questions/10298551/make-a-cell-editable-in-a-listview




The Winforms ListView control cannot be used like a DataGrid.
Only the first item can be made editable setting the property LabelEdit=True.


Are you looking to select as ListView row then update in TextBoxes then update Worksheet then update ListView?

Attach copy of your latest and I'll take a look

[djemy1975]

I want to edit data in sheets via textboxes and not directly in listview.Herewith a sample of my data.I want to use filter with the two comboboxes and the textbox then edit some data in the source sheet accordingly.Note that not all textboxes should be used in editing.

It is exacltly what you said:
looking to select as ListView row then update in TextBoxes then update Worksheet then update ListView

[djemy1975]

Please note that l have never cross posted this thread in other forums as I have full confidence in this forum.