Fill Listview form 3 identical sheets (with same headers)

Dear friends,

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

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:
Attachment 23256

'Set' is for Objects, not arrays of Strings

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

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

Code:

---

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

---

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:

Attachment 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,

Try these

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

Code:

---

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

---

I will test it and be back soon

Quote:

---

Originally Posted by Paul_Hossler

Try these

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

Code:

---

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:

Attachment 23262

Also search button is no longer working .

Please guide me to get the solution.

Best regards,

Attachment 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

Code:

---

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

---

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"

Attachment 23266

Thank you for your replies.

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

Quote:

---

Originally Posted by Paul_Hossler

Attachment 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

Code:

---

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?
Attachment 23272

Best regards,

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

https://stackoverflow.com/questions/...-in-a-listview

Quote:

---

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

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:

Quote:

---

looking to select as ListView row then update in TextBoxes then update Worksheet then update ListView

---

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