Excel VBA Column Copy Via Userform

Excel VBA Copy Column With Listbox


        Our workbook has a Database sheet and a Report sheet.
Userform opens when  the button on the Report sheet is clicked  .The userform contains two listboxes.

The column headings on the Database sheet are listed on first listbox with the following codes :
Dim sut, lst_column As Integer
lst_column = Sheets("database").Cells(1, Columns.Count).End(xlToLeft).Column
For sut = 1 To lst_column                   
  ListBox1.AddItem Sheets("database").Cells(1, sut).Value
    If Sheets("database").Columns(sut).Hidden = True Then
 ListBox1.Selected(sut - 1) = True
    End If
    Next

"Sheets("database").Cells(1, Columns.Count).End(xlToLeft).Column"  codes give us number of the last used column with header . In our template, this number is the 11 and it is column K.

excel column copy


        The item can be moved from the first listbox to the second listbox by clicking the button in between the listboxes.
If ListBox1.Text = "" Then
MsgBox "Choose an listbox item from left"
End If
If ListBox1.ListIndex > -1 Then
ListBox2.AddItem ListBox1.Value
ListBox1.RemoveItem (ListBox1.ListIndex)
End If

Likewise, items can be moved from the second listbox to the first listbox.
        When the Filter button in the Userform is clicked, the columns listed in the second listbox are copied to the Report sheet.

We used the Advanced Filter method for copying :
For basliklar = 0 To ListBox2.ListCount - 1
baslangic_satiri = 2
Sheets("report").Cells(baslangic_satiri - 1, basliklar + 1) = ListBox2.List(basliklar, 0)

Sheets("database").Range(FirstCell, LastCell).AdvancedFilter _
    Action:=xlFilterCopy, CriteriaRange:=Sheets("database").Range(FirstCell, LastCell), _
    CopyToRange:=Sheets("report").Cells(baslangic_satiri - 1, basliklar + 1), _
    Unique:=False
Next


Earlier , we found last used row and column address with that codes :
Dim FirstCell, LastCell As Range
Set LastCell = Sheets("database").Cells(Sheets("database").Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
      Sheets("database").Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
  Set FirstCell = Sheets("database").Cells(Sheets("database").Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _
      SearchDirection:=xlNext, LookIn:=xlValues).Row, _
      Sheets("database").Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _
      SearchDirection:=xlNext, LookIn:=xlValues).Column)

        The animated progress bar is loaded before column copying to Report sheet.


           

No comments:

Post a Comment