Re-Transfer Row from Listbox to another sheet VBA

I've checked all your code and tidied it up. The code will now copy the selected row to the selected sheet, remove the original data and re-populate the ListBox. All the TextBoxes are re-set as well.

I have removed all unnecessary code, change the use of RowSource to List, which is the best to use for this ListBox.

Option Explicit
Dim rData As Range


Private Sub cmbNSheet_Change()


With Sheets(Me.cmbNSheet.Value)
Set rData = .Range("A1").CurrentRegion.Offset(1)
Set rData = rData.Offset(1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
Me.TABELPENDUDUK.List = rData.Value
End With


End Sub


Private Sub CommandButton1_Click()
Dim oCtl As MSForms.Control
Dim lRw As Long    ''/// the row to copy to
''/// check a sheet to copy to is selected
If Me.NSheetKe.ListIndex = -1 Then
MsgBox "Please select a sheet to transfer to"
Me.NSheetKe.SetFocus
Exit Sub
End If
''/// copy to selected sheet using TextBoxes
With Sheets(Me.NSheetKe.Value)
lRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRw, 1).Resize(, 5).Value = Array(Me.txtNo, Me.txtID, Me.txtName, Me.txtAddress, Me.txtDOB)
End With


''/// clear the Listbox
Me.TABELPENDUDUK.Clear
''/// remove the the data from original sheet & re-populate the ListBox
With Sheets(Me.cmbNSheet.Value)
.Rows(CInt(Me.txtNo.Value) + 1).EntireRow.Delete
Set rData = .Range("A1").CurrentRegion.Offset(1)
Set rData = rData.Offset(1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
''/// clear TextBoxes
For Each oCtl In Me.Controls
If TypeName(oCtl) = "TextBox" Then oCtl.Value = Empty
Next oCtl
''///re-load the data
Me.TABELPENDUDUK.List = rData.Value
End With
End Sub


Private Sub CommandButton2_Click()
Unload Me
End Sub


Private Sub TABELPENDUDUK_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Perintah memasukkan data dari ListBox ke TextBox
With Me
.cmbNSheet.Value = ActiveSheet.Name
txtNo.Value = TABELPENDUDUK.Column(0)
txtID.Value = TABELPENDUDUK.Column(1)
txtName.Value = TABELPENDUDUK.Column(2)
txtAddress.Value = TABELPENDUDUK.Column(3)
txtDOB.Value = Format(TABELPENDUDUK.Column(4), "dd-mm-yyyy")
End With
End Sub


Private Sub UserForm_Initialize()
Dim RIAN As Long
With Me
cmbNSheet.Clear
For RIAN = 1 To Sheets.Count
cmbNSheet.AddItem Sheets(RIAN).Name
Next
NSheetKe.List = cmbNSheet.List
cmbNSheet.Value = ActiveSheet.Name
End With
End Sub

riansutarsa

Sorry I missed your last post, but the example I posted should do what you want.

It does look like my Search UserForm example but someone had changed all the code. The code that I have added will be much more efficient.

There's no data in the other sheets. Amend the code to this

Private Sub cmbNSheet_Change()


With Sheets(Me.cmbNSheet.Value)
Set rData = .Range("A1").CurrentRegion.Offset(1)
If rData.Rows.Count = 1 Then
MsgBox "No Data in Sheet " & Me.cmbNSheet.Value
Exit Sub
End If
Set rData = rData.Offset(1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
Me.TABELPENDUDUK.List = rData.Value
End With


End Sub

You don't need to use MATCH to change the value. What exactly are you searching for?

Hi Ri,

The .currentregion will not work well if you have blank rows or columns, you need to either put something in the blank cells (even one cell in the row with something in it should work) or change the method of identifying the last row to the .end(xlup) method. to use the xlup method you need a column that has, and always will have the full range... alternatively if you know you will not exceed a certain range area you may be able to define a known range such as "A1:AL1000" and then get the code to ignore the blanks somehow. Without more information about the data you are working with it is difficult to provide adaptive code. Either way I would recommend getting rid of any blank rows or columns in the data you are working with if this is the case.

If you want to try using this code to copy the format of your sheet so you can send that through I will have a quick look at what the problem may be.

Sub CpyShtFmt()

Dim ws As Worksheet: Set ws = Sheet1
Dim ws1 As Worksheet: Set ws1 = Sheet4

Dim USDRNGE, c As Range

Set USDRNGE = ws.Range("A1:AL1000")

For Each c In USDRNGE
    If c.Value <> vbNullString Then ws1.Cells(c.Row, c.Column) = Round(Rnd, 5)
Next c

USDRNGE.Copy
ws1.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats

End Sub

Is this referring to my suggestion?

Quote

ok, sir, good deal.

I just want to behave normally that switching between sheets works well

The code that I have posted for you cuts out a lot of unnecessary coding and should run very efficiently. It uses CurrentRegion which should be fine for the format of your sheets although I would recommend using proper Excel Tables.

I've just had a look at your last upload and your code needs a lot of work. Variables are not declared correctly, you are still using RowSource and the List Property is much better to load the ListBox. Have you looked at my code?

Hi Ri,

You have exceeded the number of columns a listbox can have, the maximum is 10. I normally only return the essential information in the listbox and then have a listbox click event provide the rest of the information as required. If you cut down the number of columns in your listbox to 10 the code is working.

If you need to have that many columns showing people have suggested using two listboxes side-by-side (you would need four).

I would recommend cutting down to a couple of columns that give the information the user needs to identify that they have the correct record.

Regards

Justin

Not that I am aware of using the listbox, you can try putting four listboxes next to each other.

If you make it so a couple of columns are visible in the list box, including ID number and name, and then click on it once to display the full information in the textboxes for confirmation and then double click to copy the information to the new sheet ... would that work?

It doesn't error if you have you amended the code?

You can use more ListColumns

This amended code will load all 40 columns, unfortunately you cannot use ColumnHeads.

If you had looked at my previous code and maybe asked some questions you would not have had this problem

You should not declare variables like this, only i will be a Long, the other two will be Variables

Dim EmptyTRW, EmptyFRW, i As Long

What is this code supposed to do?

mydmtch = Application.Match(Me.TABELPENDUDUK.Column(1), MyOldRNGE, 0)
For i = 0 To 37
If i = 0 Then
ws.Cells(EmptyTRW, i + 1) = "=row() - 1"
Else
ws.Cells(EmptyTRW, i + 1) = Me.TABELPENDUDUK.Column(i)
End If
Next i

Hi Ri,

Sorry to put you wrong about the number of columns in the listbox, I did not know how it could work.

Thank you Roy, obviously I am still making a lot of mistakes in my coding but I am trying to learn. Cannot believe that form of declaring variables is incorrect, I have seen it so often and just never questioned it - I just did a msgbox vartype on the variables in the list and you are quite correct only the last variable in the list is declared correctly, thank you for pointing that out.

For the code you have quoted the application.match is used in the next line after the loop to identify which row is to be deleted on the copy-from page, the loop includes a "=row() -1" because Ri wanted the numbers in the first column of his data to update relative to their location in the new sheet... the rest of the loop just copies the rest of the data to the new sheet from the selected line in the listbox.

The code you have provided is working well apart from two bugs when I run it, when you do the search in textbox6 it now requires a .clear event which the .rowsource = "" seemed to achieve previously and when changing the combobox cmbNSheet multiple times the listbox slowly expands for some reason, I cannot see a reason for it and it was not happening previously.

Ri - please note you need to add the line;

Me.TABELPENDUDUK.Clear

after the line

Me.TABELPENDUDUK.RowSource = ""

in the code for TextBox6 now , I have not tested whether you actually still need the .rowsource line.

Also whenever I have declared variables in line such as:

Dim c As Range, SchRNGE As Range

Dim EmptyTRW, EmptyFRW, i As Long

you need to modify to:

Dim c As Range, SchRNGE As Range
Dim EmptyTRW as long, EmptyFRW as long, i As Long

or as advised by Roy

Regards

Justin

I haven't bothered looking at the Search yet.

Good for you.