Fill Listview form 3 identical sheets (with same headers)

**djemy1975** · 11-23-2018, 06:29 AM

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:
error.jpg

**Paul_Hossler** · 11-23-2018, 01:01 PM

'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** · 11-23-2018, 01:31 PM

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:

Untitled.jpg

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** · 11-23-2018, 10:39 PM

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** · 11-24-2018, 01:50 AM

I will test it and be back soon

**djemy1975** · 11-24-2018, 05:15 AM

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

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:

Untitled.jpg

Also search button is no longer working .

Please guide me to get the solution.

Best regards,

**Paul_Hossler** · 11-24-2018, 09:03 AM

Capture.JPG

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** · 11-24-2018, 10:09 AM

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"

Untitled.jpg

Thank you for your replies.

**djemy1975** · 11-25-2018, 09:20 AM

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

**djemy1975** · 11-26-2018, 02:20 PM

Originally Posted by Paul_Hossler

Capture.JPG

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?
worked.jpg

Best regards,

**Paul_Hossler** · 11-27-2018, 08:55 AM

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

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** · 11-27-2018, 09:09 AM

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** · 11-28-2018, 12:52 PM

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

Thread: Fill Listview form 3 identical sheets (with same headers)

Thread Tools

Display

Fill Listview form 3 identical sheets (with same headers)

Posting Permissions