Re-Transfer Row from Listbox to another sheet VBA

**royUK** · Mar 25th 2020

I can't see why here is a need for using row numbers.

I will look at this when I get chance

R.Soeta · Mar 25th 2020

okey sir, thank you

Justin Doward · Mar 25th 2020

Hi Ri,

Not sure if you are getting the error of the height changing on the listbox, it is the integralheight property on the listbox. Change it from true to false and the listbox will stop size changing.

For the search I finally got my head around the .rowsource syntax and this appears to be the only way you can get over 10 columns in your listbox. As far as I can tell a helper sheet is the best way to get this to work.

I created a new sheet, sheet4 then used the code below:

Code

Private Sub TextBox6_Change()

Application.ScreenUpdating = False
Dim c As Range, MyRnge As Range, SchRNGE As Range
Dim MyRnger As String
Dim ws1 As Worksheet: Set ws1 = Sheets(Me.cmbNSheet.Value)
Dim ws4 As Worksheet: Set ws4 = Sheet4 ' The helper sheet
Dim EmptyTRW As Long, EmptyFRW As Long, i As Long, MyRW As Long
Set SchRNGE = ws1.Range(ws1.Cells(1, 1), ws1.Cells(ws1.Cells(1, 1).CurrentRegion.Rows.Count, ws1.Range("A1").CurrentRegion.Columns.Count))
Me.TABELPENDUDUK.ColumnHeads = False
Me.TABELPENDUDUK.ColumnCount = ws1.Range("A1").CurrentRegion.Columns.Count
Me.TABELPENDUDUK.RowSource = ""

ws4.Cells.Clear
ws1.Rows(1).EntireRow.Copy ws4.Range("A1")

For Each c In SchRNGE
    If Me.TextBox6.Value <> vbNullString And InStr(c.Value, Me.TextBox6.Value) > 0 Then
    If c.Row = MyRW Or c.Row = 1 Then GoTo MyNxt
    nxtrw = ws4.Cells(1, 1).CurrentRegion.Rows.Count
            For i = 1 To 40
              ws4.Cells(nxtrw + 1, i) = ws1.Cells(c.Row, i)
            Next i
            MyRW = c.Row
MyNxt:
    End If
Next c
MyRnger = ws4.Range("A1").CurrentRegion.Address
Me.TABELPENDUDUK.RowSource = ws4.Name & "!" & MyRnger

End Sub

Display More

R.Soeta · Mar 25th 2020

good sir Justin, I will try it right now, thank you for your help so far

**royUK** · Mar 25th 2020

I don't what's happening, but I'm out.

I've already said that you can't use RowSource withall those Columns, also that RowSource is not the best way to load the ListBox.

R.Soeta · Mar 25th 2020

Good job, Mr. Justin, thank you very much. the code works well.

thank you very much for the sacrifice of your time and thoughts.

to Mr. royUK also I thank you very much for your attention and understanding so far

always healthy everything

Justin Doward · Mar 25th 2020

Cheers Ri,

I am trying to learn the art, was wrong about the method for getting the rows into the listbox apparently it becomes limited if you use .additem for some reason (or that is the best I can work out).

I am trying to get the search results to fill an array and use that array as the list for the listbox, I will post the code if I work it out.. it is a much better way to do it than using a helper sheet.

Regards

Justin

R.Soeta · Mar 25th 2020

Yes, Mr. Justin, again I say thank you very much.

Regards

Rian

Justin Doward · Mar 25th 2020

Here it is using an array instead of a helper sheet

Let me know how it goes.

Code

Private Sub TextBox6_Change()

Application.ScreenUpdating = False
Dim c As Range, SchRNGE As Range
Dim MyArr()
Dim ws1 As Worksheet: Set ws1 = Sheets(Me.cmbNSheet.Value)
Dim i As Long, MyX As Long, MyRW As Long
Set SchRNGE = ws1.Range(ws1.Cells(1, 1), ws1.Cells(ws1.Cells(1, 1).CurrentRegion.Rows.Count, ws1.Range("A1").CurrentRegion.Columns.Count))
Me.TABELPENDUDUK.RowSource = ""
Me.TABELPENDUDUK.ColumnCount = 40
Me.TABELPENDUDUK.ColumnHeads = False

x = 0

For Each c In SchRNGE 'this loop determines the required size of the array MyArr()
    If Me.TextBox6.Value <> vbNullString And InStr(c.Value, Me.TextBox6.Value) > 0 Then
    If c.Row = MyRW Or c.Row = 1 Then GoTo MyNxt
        x = x + 1
    MyRW = c.Row
MyNxt:
    End If
Next c

MyRW = 0

ReDim MyArr(x + 1, 39) 'this sizes the array with + 1 for the header

For MyX = 0 To 39 ' this loop adds the header information
    MyArr(0, MyX) = ws1.Cells(1, MyX + 1)
Next MyX

n = 1
For Each c In SchRNGE ' this loop adds the found values to the array
    If Me.TextBox6.Value <> vbNullString And InStr(c.Value, Me.TextBox6.Value) > 0 Then
    If c.Row = MyRW Or c.Row = 1 Then GoTo MyNxt1
            For i = 0 To 39
                 MyArr(n, i) = ws1.Cells(c.Row, i + 1)
            Next i
            n = n + 1
            MyRW = c.Row
MyNxt1:
    End If
Next c

Me.TABELPENDUDUK.List = MyArr

End Sub

Display More

Justin Doward · Mar 25th 2020

I was also going to suggest you change your naming of the textboxes to something sequential like TB1 through TB31, then you could use a loop to fill them:

Code

Private Sub TABELPENDUDUK_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Perintah memasukkan data dari ListBox ke TextBox
Dim I As Long

For I = 1 To 31
Me.Controls("TB" & I).Value = Me.TABELPENDUDUK.Column(I - 1)
Next I

End Sub

R.Soeta · Mar 25th 2020

Yes, thank you Mr. Justin all very helpful.

oh yes, the second code for the search engine looks better, but I have problems to display the date format how to make the format to "dd-mm-yyyy"?

FaKest · Mar 25th 2020

Maybe you can help me as well?

First I apologize if I am posting in the wrong forum, however it seems related to me.

I am learning VBA and checkbox (listbox maybe) is difficult for me.

I have a workbook with a lot of sheets. However, I need help with 2 sheets.

Sheet ("Alert") have a table with 5 columns I wish to copy to Sheet("Alert2") using a button or when the checkbox on Column M is checked (however only the information in the row that have the checkbox checked need to be copied).

I am trying all the code I can find, but nothing works the way I need.

Thank you so much for your time.

Justin Doward · Mar 26th 2020

Hi Flavia,

You are in the right forum but you need to post a new thread, the moderators need to make sure you read the rules here as they like to keep it organised so that people searching for solutions in future can easily find a solution if it has already been provided. Also you will need to post a representative file showing what your problem is and describing the solution you hope to obtain as it is often a waste of time for others to try and do this on your behalf.

Best of luck

Justin

Justin Doward · Mar 26th 2020

HI Ri,

That is a strange one, the date is stored dd/mm/yyyy in the array and then changes to mm/dd/yyyy in the listbox. This appears to fix it, but I do not know why it needs fixing.

Code

Private Sub TextBox6_Change()


Application.ScreenUpdating = False
Dim c As Range, SchRNGE As Range
Dim MyArr()
Dim ws1 As Worksheet: Set ws1 = Sheets(Me.cmbNSheet.Value)
Dim I As Long, MyX As Long, MyRW As Long
Set SchRNGE = ws1.Range(ws1.Cells(1, 1), ws1.Cells(ws1.Cells(1, 1).CurrentRegion.Rows.Count, ws1.Range("A1").CurrentRegion.Columns.Count))
Me.TABELPENDUDUK.RowSource = ""
Me.TABELPENDUDUK.ColumnCount = 40
Me.TABELPENDUDUK.ColumnHeads = False

x = 0

For Each c In SchRNGE 'this loop determines the required size of the array MyArr()
If Me.TextBox6.Value <> vbNullString And InStr(c.Value, Me.TextBox6.Value) > 0 Then
If c.Row = MyRW Or c.Row = 1 Then GoTo MyNxt
x = x + 1
MyRW = c.Row
MyNxt:
End If
Next c

MyRW = 0

ReDim MyArr(x + 1, 39) 'this sizes the array with + 1 for the header

For MyX = 0 To 39 ' this loop adds the header information
MyArr(0, MyX) = ws1.Cells(1, MyX + 1)
Next MyX

n = 1
For Each c In SchRNGE ' this loop adds the found values to the array
If Me.TextBox6.Value <> vbNullString And InStr(c.Value, Me.TextBox6.Value) > 0 Then
If c.Row = MyRW Or c.Row = 1 Then GoTo MyNxt1
For I = 0 To 39
MyArr(n, I) = ws1.Cells(c.Row, I + 1)
Next I
n = n + 1
MyRW = c.Row
MyNxt1:
End If
Next c
Me.TABELPENDUDUK.List = MyArr

For I = 0 To n - 1

Me.TABELPENDUDUK.List(I, 7) = Format(Me.TABELPENDUDUK.List(I, 7), "dd/mm/yyyy")
Next I

End Sub

Display More

R.Soeta · Mar 26th 2020

Okay Fix Mr. Justin, Thank you so much

Justin Doward · Mar 26th 2020

Ri,

This also fixes the date problem, put .text on the end of the cell reference when filling the array keeps the existing format - I am not sure if it will introduce other errors with the numbers though:

Code

Application.ScreenUpdating = False
Dim c As Range, SchRNGE As Range
Dim MyArr()
Dim ws1 As Worksheet: Set ws1 = Sheets(Me.cmbNSheet.Value)
Dim I As Long, MyX As Long, MyRW As Long
Set SchRNGE = ws1.Range(ws1.Cells(1, 1), ws1.Cells(ws1.Cells(1, 1).CurrentRegion.Rows.Count, ws1.Range("A1").CurrentRegion.Columns.Count))
Me.TABELPENDUDUK.RowSource = ""
Me.TABELPENDUDUK.ColumnCount = 40
Me.TABELPENDUDUK.ColumnHeads = False
x = 0
For Each c In SchRNGE 'this loop determines the required size of the array MyArr()
If Me.TextBox6.Value <> vbNullString And InStr(c.Value, Me.TextBox6.Value) > 0 Then
If c.Row = MyRW Or c.Row = 1 Then GoTo MyNxt
x = x + 1
MyRW = c.Row
MyNxt:
End If
Next c
MyRW = 0
ReDim MyArr(x + 1, 39) 'this sizes the array with + 1 for the header
For MyX = 0 To 39 ' this loop adds the header information
MyArr(0, MyX) = ws1.Cells(1, MyX + 1)
Next MyX
n = 1
For Each c In SchRNGE ' this loop adds the found values to the array
If Me.TextBox6.Value <> vbNullString And InStr(c.Value, Me.TextBox6.Value) > 0 Then
If c.Row = MyRW Or c.Row = 1 Then GoTo MyNxt1
For I = 0 To 39
MyArr(n, I) = ws1.Cells(c.Row, I + 1).Text
Next I
n = n + 1
MyRW = c.Row
MyNxt1:
End If
Next c
Me.TABELPENDUDUK.List = MyArr


End Sub

Display More

R.Soeta · Mar 28th 2020

Mr. Justin, help me again, I have a problem in the search box.

after I get the first search result, then when I type for the next search it generates an error: Subscript Out of Range with debugs:

Dim ws1 As Worksheet: Set ws1 = Sheets (Me.cmbNSheet.Value)

Justin Doward · Mar 28th 2020

Hi Ri,

I will have a look, but upload the version you are using... the last time I used it there did not seem to be a problem.

R.Soeta · Mar 28th 2020

Yes sir, there really is no problem when the workbook that is opened is only the file. but when I open another workbook the problem appears

Re-Transfer Row from Listbox to another sheet VBA

Participate now!

Share

Users Viewing This Thread