Consulting

Results 1 to 13 of 13

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

  1. #1

    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:
    '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
    Attached Files Attached Files

  2. #2
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,720
    Location
    '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
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    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,
    Last edited by djemy1975; 11-23-2018 at 03:58 PM.

  4. #4
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,720
    Location
    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
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    I will test it and be back soon

  6. #6
    Quote Originally Posted by Paul_Hossler View Post
    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,
    Last edited by djemy1975; 11-24-2018 at 05:27 AM.

  7. #7
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,720
    Location
    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
    Attached Files Attached Files
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  8. #8
    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.

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

  10. #10
    Quote Originally Posted by Paul_Hossler View Post
    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,
    Last edited by djemy1975; 11-26-2018 at 04:01 PM.

  11. #11
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,720
    Location
    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
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  12. #12
    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
    Attached Files Attached Files
    Last edited by djemy1975; 11-27-2018 at 01:36 PM.

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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •