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:
If anyone can help, it would be greatly appreciated.
Thanks
Chris
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 SubIf anyone can help, it would be greatly appreciated.
Thanks
Chris
