Listview issue

C

cdchapman

Board Regular
Joined
Dec 30, 2010
Messages
112
Can anyone help me with the following?

I have a userform that utilizes a listview control to display a range of cells from a worksheet. Initally this range is around 7000 rows by 75 columns. Via the use of various other controls, users can then filter this list to whatever they require.

My issue is this. When the listview control is being populated with the full 7000 by 75 range of cells (either on inital load or if all filters have been cleared), it takes a long time (typically around 6 to 7 minutes). This is not going to be acceptable to the users, so I need to find a quicker way of populating the listview. When the listview is being populated with a filtered list, then this is a lot quicker, due to the lower number of rows I suspect.

The current code for populating the listview is as follows:

Code: 
Sub Get_Data(refreshType As String, displayScope As String)
'Get the data from the worksheet

    Dim column_header As ColumnHeader
    Dim list_item As ListItem
    Dim column_counter As Double
    Dim row_counter As Double
    
    frmMAIN.lblDATARET.Visible = True
    frmMAIN.pgbProgress.Visible = True
    CURRENT_PB_VALUE = 0
    frmMAIN.pgbProgress.Max = Worksheets("Data").Range("H5").Value        ***This holds the current number of worksheet rows to be shown in the listview control
    frmMAIN.lvwDETAILS.Appearance = cc3D
    frmMAIN.lvwDETAILS.View = lvwReport
    frmMAIN.lvwDETAILS.LabelWrap = True

    'Create the column headers (on frmMAIN initialisation only)
    If refreshType = "I" Then    'Initialisation only
        frmMAIN.lvwDETAILS.ColumnHeaders.Clear
        For column_counter = 1 To 500
            If WSDATA.Cells(9, column_counter).Value = "" Then
                Exit For
            Else
                If WSDATA.Cells(9, column_counter).Value <> "Number of Policy Instances" Then
                    Set column_header = frmMAIN.lvwDETAILS. _
                        ColumnHeaders.Add(, , "" & VBA.Replace(WSDATA.Cells(9, column_counter).Value, Chr(10), " ") & "", Len("" & VBA.Replace(WSDATA.Cells(9, column_counter).Value, Chr(10), " ") & "") + 100)
                    End If
            End If
        Next column_counter
    End If
    WSDATA.Select                            ***WSDATA is a global worksheet variable that has been set in a previous subroutine
    Cells(10, "A").Select
    frmMAIN.lvwDETAILS.ListItems.Clear
    For row_counter = 10 To WSDATA.Cells(Rows.Count, 1).End(xlUp).Row
        'frmMAIN.lvwDETAILS.Visible = False
        If Not WSDATA.Rows("" & row_counter & "").Hidden Then
            Select Case displayScope
                Case "A"    'All types
                    Set list_item = frmMAIN.lvwDETAILS.ListItems.Add(, , "" & WSDATA.Cells(row_counter, 1).Value & "")
                    Select Case VBA.UCase(WSDATA.Cells(row_counter, 8).Value)
                        Case "TEAM 1"
                            list_item.ForeColor = VBA.RGB(200, 20, 20)
                            list_item.Bold = True
                        Case "TEAM 2"
                            list_item.ForeColor = VBA.RGB(20, 20, 140)
                            list_item.Bold = True
                        Case "TEAM 3"
                            list_item.ForeColor = VBA.RGB(20, 140, 20)
                            list_item.Bold = True
                        Case "TEAM 4"
                            list_item.ForeColor = VBA.RGB(100, 200, 220)
                            list_item.Bold = True
                    End Select
                    For column_counter = 2 To 500
                        If WSDATA.Cells(9, column_counter).Value = "" Then
                            Exit For
                        Else
                            If WSDATA.Cells(9, column_counter).Value <> "Number of Policy Instances" Then
                                list_item.SubItems(column_counter - 1) = WSDATA.Cells(row_counter, column_counter).Value
                                Select Case VBA.UCase(WSDATA.Cells(row_counter, 8).Value)
                                    Case "TEAM 1"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(200, 20, 20)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                    Case "TEAM 2"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(20, 20, 140)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                    Case "TEAM 3"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(20, 140, 20)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                    Case "TEAM 4"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(100, 200, 220)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                End Select
                            End If
                        End If
                    Next column_counter
           Case "R"    'Only rows with a value in column G on the worksheet
                If WSDATA.Cells(row_counter, 7).Value <> "" Then
                    Set list_item = frmMAIN.lvwDETAILS.ListItems.Add(, , "" & WSDATA.Cells(row_counter, 1).Value & "")
                    Select Case VBA.UCase(WSDATA.Cells(row_counter, 8).Value)
                        Case "TEAM 1"
                            list_item.ForeColor = VBA.RGB(200, 20, 20)
                            list_item.Bold = True
                        Case "TEAM 2"
                            list_item.ForeColor = VBA.RGB(20, 20, 140)
                            list_item.Bold = True
                        Case "TEAM 3"
                            list_item.ForeColor = VBA.RGB(20, 140, 20)
                            list_item.Bold = True
                        Case "TEAM 4"
                            list_item.ForeColor = VBA.RGB(100, 200, 220)
                            list_item.Bold = True
                    End Select
                    For column_counter = 2 To 500
                        If WSDATA.Cells(9, column_counter).Value = "" Then
                            Exit For
                        Else
                            If WSDATA.Cells(9, column_counter).Value <> "Number of Policy Instances" Then
                                list_item.SubItems(column_counter - 1) = WSDATA.Cells(row_counter, column_counter).Value
                                Select Case VBA.UCase(WSDATA.Cells(row_counter, 8).Value)
                                    Case "TEAM 1"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(200, 20, 20)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                    Case "TEAM 2"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(20, 20, 140)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                    Case "TEAM 3"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(20, 140, 20)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                    Case "TEAM 4"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(100, 200, 220)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                End Select
                            End If
                        End If
                    Next column_counter
                End If
            Case "U"        'Only rows that have no value in column G on the worksheet
                If WSDATA.Cells(row_counter, 7).Value = "" Then
                    Set list_item = frmMAIN.lvwDETAILS.ListItems.Add(, , "" & WSDATA.Cells(row_counter, 1).Value & "")
                    Select Case VBA.UCase(WSDATA.Cells(row_counter, 8).Value)
                        Case "TEAM 1"
                            list_item.ForeColor = VBA.RGB(200, 20, 20)
                            list_item.Bold = True
                        Case "TEAM 2"
                            list_item.ForeColor = VBA.RGB(20, 20, 140)
                            list_item.Bold = True
                        Case "TEAM 3"
                            list_item.ForeColor = VBA.RGB(20, 140, 20)
                            list_item.Bold = True
                        Case "TEAM 4"
                            list_item.ForeColor = VBA.RGB(100, 200, 220)
                            list_item.Bold = True
                    End Select
                    For column_counter = 2 To 500
                        If WSDATA.Cells(9, column_counter).Value = "" Then
                            Exit For
                        Else
                            If WSDATA.Cells(9, column_counter).Value <> "Number of Policy Instances" Then
                                list_item.SubItems(column_counter - 1) = WSDATA.Cells(row_counter, column_counter).Value
                                Select Case VBA.UCase(WSDATA.Cells(row_counter, 8).Value)
                                    Case "TEAM 1"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(200, 20, 20)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                    Case "TEAM 2"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(20, 20, 140)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                    Case "TEAM 3"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(20, 140, 20)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                    Case "TEAM 4"
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).ForeColor = VBA.RGB(100, 200, 220)
                                        frmMAIN.lvwDETAILS.ListItems(list_item.Index).ListSubItems.Item(column_counter - 1).Bold = True
                                End Select
                            End If
                        End If
                    Next column_counter
                End If
            End Select
            CURRENT_PB_VALUE = CURRENT_PB_VALUE + 1
            Call UpdateProgressBar
        End If
    Next row_counter
  
    'Update the number of records label
    frmMAIN.lblNOOFRECS.Caption = frmMAIN.lvwDETAILS.ListItems.Count & " of " & WSDATA.Cells(3, "H").Value - 9 & " records found"
    
    frmMAIN.lblDATARET.Visible = False
    frmMAIN.pgbProgress.Visible = False

End Sub

If anyone can help, it would be greatly appreciated.

Thanks
Chris
 
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

H
  • Question Question
Referencing a series name that contains data linked to a cell VBA
Replies
1
Views
160
Rijnsent
Rijnsent
H
  • Locked
  • Question Question
Help referencing a series name that contains data linked to a cell VBA
Replies
1
Views
159
Fluff
Fluff
P
  • Question Question
Hoping to get help with a Macro!
Replies
0
Views
308
PEM000
P
A
  • Solved
Row Height adjusted based on content - not for a cell but for a range of cells
Replies
8
Views
191
kvsrinivasamurthy
K
J
  • Question Question
Assistance changing VBA code to display as HTML or picture of a selection in Lotus Notes
Replies
2
Views
297
jularobert
J

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top