Copying and filtering worksheets and Excel tables

What can you learn here ?
  • Select worksheets to copy
  • Choose selected columns 
  • cDataSets filtering capability

Copying partial tables between sheets get it now

By now you are probably familiar with the cDataSets classes. Here is a straightforward implementation that provides a form you can use to select fields in a table to be copied to other sheets. It should demonstrate how versatile applications can be built in a very short time. 

The control form.

This is the fFilter form in cDataSet.slsm, and allow you to
  • Select which worksheet needs to be copied
  • Create a new sheet or copy data to an existing one.
  • Select fields to be copied from the list of fields on that sheet
  • Filter for particular values in a field to qualify or disqualify the table row from being copied over

Creating the list of fields on a worksheet

When a worksheet is selected, we clear the listboxes and filter fields, which are dependent on which worksheet is selected,  and we create a new dataset based on the newly selected worksheet.  Finding which column headings are present in the sheet then becomes a simple iteration through the .Headings property.  By default these are all assumed to be fields to copy, so they are added to the selected listbox.  The .populateData method is restricted to only read 1 row here, since we are only interested in the headings at this point and don't need to waste time reading the data.

Private Sub cbxWsIn_Click()
    Dim hc As cCell
    
    clearxb lbxAvailable
    clearxb lbxSelected
    clearxb cbxFilterField
    
    With cbxFilterField
        .AddItem cNotSelectedFilter
        .Value = .List(0)
    End With
    
    With New cDataSet
        .populateData wholeSheet(cbxWsIn.Value), , , , , , True, , 1
        If Not .Where Is Nothing Then
            For Each hc In .Headings
                lbxSelected.AddItem hc.toString
                cbxFilterField.AddItem hc.toString
            Next hc
        End If
    End With

End Sub

Selecting and deselecting the fields to be copied
By default, all fields are in the right hand list box meaning that they will be copied from the old sheet to the new sheet. The < and > command buttons allow this behavior to be modified by moving fields between the 'available' and 'selected' listboxes. 

This is how to move selections between two listboxes that have been set to allow multiple selections.

Private Sub cbSelect_Click()
    moveList lbxAvailable, lbxSelected, True
End Sub
Private Sub cbunSelect_Click()
    moveList lbxSelected, lbxAvailable, False
End Sub
Private Sub moveList(lbFrom As MSForms.ListBox, lbTo As MSForms.ListBox, bSelecting As Boolean)
        Dim i As Long
        With lbFrom
            If .ListIndex = -1 Then Exit Sub
            For i = .ListCount - 1 To 0 Step -1
                If .Selected(i) Then
                    lbTo.AddItem .List(i)
                    .RemoveItem i
                End If
            Next i
        End With
End Sub

Finally this is what happens onSubmit.   This time .populate data reads all the data in the input worksheet. The .bigCommit method has all the capabilities to copy from a data set to some other set of worksheet cells, and also knows how to apply the selected filter to only copy over qualifying records.

Private Sub cbSubmit_Click()
    Dim ws As Worksheet, ds As cDataSet, a() As String, i As Long, sf As String
    With lbxSelected
        For i = 0 To .ListCount - 1
            ReDim Preserve a(1 To i + 1)
            a(UBound(a)) = .List(i)
        Next i
    End With
    
    If UBound(a) >= LBound(a) Then
        If cbxWsOut.Value = cNotSelectedWsOut Then
            'create a sheet
            Set ws = Sheets.add
        Else
            Set ws = Sheets(cbxWsOut.Value)
            ws.Activate
        End If
    
        With New cDataSet
            ' get input sheet
            .populateData wholeSheet(cbxWsIn.Value), , , , , , True
            If cbxFilterField.Value = cNotSelectedFilter Then
                sf = vbNullString
            Else
                sf = cbxFilterField.Value
            End If
            
            .bigCommit ws.Cells(1, 1), True, a, sf, tbFilterMatch.Value, chbApproximate.Value
            
        End With
    Else
        MsgBox ("nothing to do")
    End If
    
End Sub


Comments