Code to migrate the list box data to excel sheet

saftawy1

New Member
Joined
Oct 12, 2021
Messages
42
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
I need help with this code
Use this code to migrate the list box data to excel sheet and it works fine if the number of rows in the list box is small, but if the number of rows is more than 100 or 150, it is very slow in the migration
Do I find a solution to this?

VBA Code:
[QUOTE]
Dim z As Integer
Dim v As Integer
   Application.ScreenUpdating = False

    With ThisWorkbook.Sheets("report2").Range("b5:s2000").ClearContents

        z = 5
        For v = 0 To ListBox1.ListCount
        On Error Resume Next
            ThisWorkbook.Sheets("report2").Cells(z, 2).Value = CDate(ListBox1.List(v, 0))
            ThisWorkbook.Sheets("report2").Cells(z, 3).Value = CDate(ListBox1.List(v, 1))
            ThisWorkbook.Sheets("report2").Cells(z, 4).Value = CDate(ListBox1.List(v, 2))
            ThisWorkbook.Sheets("report2").Cells(z, 5).Value = ListBox1.List(v, 3)
            ThisWorkbook.Sheets("report2").Cells(z, 6).Value = ListBox1.List(v, 4)
            ThisWorkbook.Sheets("report2").Cells(z, 7).Value = ListBox1.List(v, 5)
            ThisWorkbook.Sheets("report2").Cells(z, 8).Value = ListBox1.List(v, 6)
            ThisWorkbook.Sheets("report2").Cells(z, 9).Value = ListBox1.List(v, 7)
            ThisWorkbook.Sheets("report2").Cells(z, 10).Value = ListBox1.List(v, 8)
            ThisWorkbook.Sheets("report2").Cells(z, 11).Value = ListBox1.List(v, 9)
            ThisWorkbook.Sheets("report2").Cells(z, 12).Value = ListBox1.List(v, 10)
            ThisWorkbook.Sheets("report2").Cells(z, 13).Value = ListBox1.List(v, 11)
            ThisWorkbook.Sheets("report2").Cells(z, 14).Value = ListBox1.List(v, 12)
            ThisWorkbook.Sheets("report2").Cells(z, 15).Value = ListBox1.List(v, 13)
            ThisWorkbook.Sheets("report2").Cells(z, 16).Value = ListBox1.List(v, 14)
            ThisWorkbook.Sheets("report2").Cells(z, 17).Value = ListBox1.List(v, 15)
            ThisWorkbook.Sheets("report2").Cells(z, 18).Value = ListBox1.List(v, 16)
            ThisWorkbook.Sheets("report2").Cells(z, 19).Value = ListBox1.List(v, 17)
            z = z + 1
        Next
    End With
    On Error GoTo 0
    Application.ScreenUpdating = True
[/QUOTE]
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
20,648
Office Version
  1. 365
Platform
  1. Windows
Try the following instead . . .

VBA Code:
    With Me.ListBox1
        ThisWorkbook.Sheets("report2").Range("B2").Resize(.ListCount, .ColumnCount).Value = .List
    End With

Does this help?
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
20,648
Office Version
  1. 365
Platform
  1. Windows
Actually, since you want to format the first three columns of the transferred data as a date, try...

VBA Code:
    Dim wsDest As Worksheet
    Set wsDest = ThisWorkbook.Sheets("report2")
    
    With Me.ListBox1
        wsDest.Range("B2").Resize(.ListCount, .ColumnCount).Value = .List
    End With
    
    With wsDest
        .Range("B2:D" & .Cells(.Rows.Count, "B").End(xlUp).Row).NumberFormat = "mm/dd/yyyy"
    End With

Change the format as desired.
 
Solution

saftawy1

New Member
Joined
Oct 12, 2021
Messages
42
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Actually, since you want to format the first three columns of the transferred data as a date, try...

VBA Code:
    Dim wsDest As Worksheet
    Set wsDest = ThisWorkbook.Sheets("report2")
   
    With Me.ListBox1
        wsDest.Range("B2").Resize(.ListCount, .ColumnCount).Value = .List
    End With
   
    With wsDest
        .Range("B2:D" & .Cells(.Rows.Count, "B").End(xlUp).Row).NumberFormat = "mm/dd/yyyy"
    End With

Change the format as desired.
thank you very much its doing excellent
 

Forum statistics

Threads
1,181,673
Messages
5,931,346
Members
436,787
Latest member
ogharipour

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
Top