Member Avatar for claw72

hi people

can anyone help me how to simplify these codes?

Set oExcel = CreateObject("Excel.Application")
    Set oBook = ThisWorkbook
    Set osheet3 = oBook.Worksheets("DBASE")
    Set osheet4 = oBook.Worksheets("List Box Lookup Demonstration")
    Dim listIndex As Variant
      
    On Error Resume Next
    osheet3.Select
    Range("b65536").End(xlUp).Offset(1, 0).Select
    Selection.Value = ListBox2.List(0)
    Selection.Offset(0, -1).Value = TextBox2.Text
    Selection.Offset(0, 1).Value = TextBox3.Text
    Selection.Offset(1, 0).Value = ListBox2.List(1)
    Selection.Offset(2, 0).Value = ListBox2.List(2)
    Selection.Offset(3, 0).Value = ListBox2.List(3)
    Selection.Offset(4, 0).Value = ListBox2.List(4)
    Selection.Offset(5, 0).Value = ListBox2.List(5)
    Selection.Offset(6, 0).Value = ListBox2.List(6)
    Selection.Offset(7, 0).Value = ListBox2.List(7)
    Selection.Offset(8, 0).Value = ListBox2.List(8)
    Selection.Offset(9, 0).Value = ListBox2.List(9)
    Selection.Offset(10, 0).Value = ListBox2.List(10)
    Selection.Offset(11, 0).Value = ListBox2.List(11)
    Selection.Offset(12, 0).Value = ListBox2.List(12)
    Selection.Offset(13, 0).Value = ListBox2.List(13)
    Selection.Offset(14, 0).Value = ListBox2.List(14)
    Selection.Offset(15, 0).Value = ListBox2.List(15)
    Selection.Offset(16, 0).Value = ListBox2.List(16)
    Selection.Offset(17, 0).Value = ListBox2.List(17)
    Selection.Offset(18, 0).Value = ListBox2.List(18)
    Selection.Offset(19, 0).Value = ListBox2.List(19)
    Selection.Offset(20, 0).Value = ListBox2.List(20)
    
    Selection.Offset(0, -1).Select
    Selection.Copy
    Selection.Offset(0, 1).End(xlDown).Offset(-1, -1).Select
    Range(Selection, Selection.End(xlUp)).Offset(1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("C65536").End(xlUp).Select
    Selection.Copy
    Selection.Offset(0, -1).End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
  • 2 Contributors
  • 2 Replies
  • 125 Views
  • 1 Day Discussion Span
  • Latest Post Latest Post by claw72

Dani AI

Generated

A few targeted improvements that keep 's idea but make it correct, robust and much faster:

  • Avoid Select/Selection. Work with worksheet and Range objects directly.
  • Use ListCount so the code adapts to any number of list items instead of hard-coding 21.
  • Find the next free row with Cells(Rows.Count, "B").End(xlUp).Row + 1 so it works on modern Excel.
  • Fill a 2-D Variant array with the values (A = TextBox2, B = each ListBox item, C = TextBox3) and write the whole block back in one shot. This removes the copy/paste gymnastics and is far faster on larger lists.
  • Turn off ScreenUpdating while running and avoid broad On Error Resume Next unless you handle errors.

Example (safe, simple, and different from the snippets already posted):

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("DBASE")

Dim n As Long
n = ListBox2.ListCount
If n = 0 Then Exit Sub

Dim startRow As Long
startRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1

Dim data() As Variant
ReDim data(1 To n, 1 To 3)

Dim i As Long
For i = 1 To n
    data(i, 1) = Trim(TextBox2.Text)
    data(i, 2) = ListBox2.List(i - 1)
    data(i, 3) = Trim(TextBox3.Text)
Next i

ws.Range(ws.Cells(startRow, 1), ws.Cells(startRow + n - 1, 3)).Value = data

Notes: use Long for row counters, Option Explicit, and consider Application.ScreenUpdating = False for performance. If only selected ListBox entries should be written, loop through ListBox2.ListCount and check .Selected(index) before adding to the array. This approach keeps the logic clear and avoids the copy/paste fragility seen earlier; thanks to for the loop direction and to for confirming it worked.

Recommended Answers

All 2 Replies

Member Avatar for cguan_77

don't know if this is what you want

Set oExcel = CreateObject("Excel.Application")    
Set oBook = ThisWorkbook    
Set osheet3 = oBook.Worksheets("DBASE")   
Set osheet4 = oBook.Worksheets("List Box Lookup Demonstration")   
 Dim listIndex As Variant    
 Dim i as integer
      
    On Error Resume Next
    osheet3.Select
    Range("b:b").End(xlUp).Offset(1, 0).Select
    Selection.Value = ListBox2.List(0)
    Selection.Offset(0, -1).Value = TextBox2.Text

     for i = 1 to 20
    Selection.Offset(0, 1).Value = TextBox3.Text
    Selection.Offset(i, 0).Value = ListBox2.List(i)
     next i
    
    Selection.Offset(0, -1).Select
    Selection.Copy
    Selection.Offset(0, 1).End(xlDown).Offset(-1, -1).Select
    Range(Selection, Selection.End(xlUp)).Offset(1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("C:C").End(xlUp).Select
    Selection.Copy
    Selection.Offset(0, -1).End(xlDown).Offset(0, 1).Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
Member Avatar for claw72

yah.. thanks much sir.

thats really it is.

thank you very much again..

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.