CODEWITHSUNDEEP
vbaexcel
Niva
Niva

Reputation: 298

Incorporating refedit into Vlookup userform

I have a vlookup userform which autofills the details in the form based on the seat n°.

enter image description here

Now I want to incoroporate a ref edit to paste these data from the text box to the cells the user chooses with the refedit. Hence i would need some help in going about these.
This is the code i have used.

I potentially want to insert 3 refedit boxes for user to select the cell they want to paste each of the data (Name,Dept and Ext No.) from the textbox.

See my code below:

Option Explicit

Private Sub Frame1_Click()

End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

   Dim answer As Integer
   answer = TextBox1.Value
   TextBox2.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 2, False)
   TextBox3.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 3, False)
   TextBox4.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 4, False)

End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub TextBox3_Change()

End Sub

Private Sub TextBox4_Change()

End Sub
Private Sub CancelButton_Click()

    Unload Me
    End
End Sub

I have tried figuring out a code to solve this issue but I am getting an object required error. My rngcopy would be textbox2.value (Name) and the rngpaste location would be the ref edit 1.

This is the code

Private Sub PasteButton_Click()

Dim rngCopy As Range, rngPaste As Range
Dim wsPaste As Range
Dim answer As Integer
answer = TextBox1.Value
If RefEdit1.Value <> "" Then

        TextBox2.Value = WorksheetFunction.VLookup(answer, Sheets("L12 - Data Sheet").Range("B:E"), 2, False)
        Set rngCopy = TextBox2.Value
        Set wsPaste = ThisWorkbook.Sheets(Replace(Split(TextBox2.Value, "!")(0), "'", ""))
        Set rngPaste = wsPaste.Range(Split(TextBox2.Value, "!")(1))

        rngCopy.Copy rngPaste
  Else
        MsgBox "Please select an Output range"
    End If
End Sub

Upvotes: 1

Views: 383

Answers (2)

grug.0
grug.0

Reputation: 355

You are declaring your rngCopy as a Range Object and then later on you are binding it to a .value method of the range object.

Set rngCopy = TextBox2.Value

This is likely where you are encountering errors. Try declaring a string and assigning it to your copy value.

Dim string1 As String
string1 = TextBox2.Value

Step through your code editor with the LOCALS window open, and watch what happens to your rngCopy object when you assign a string to it.

Upvotes: 1

Florent B.
Florent B.

Reputation: 42538

You should get the row index with Match and expose it to the form so it can be used by the copy function. And to set the target pointed by a Ref control, just evalute the .Value property with Range():

Range(RefEdit.Value).cells(1, 1) = Worksheet.Cells(row, column)

The form:

enter image description here

The code:

' constants to define the data
Const SHEET_DATA = "L12 - Data Sheet"
Const COLUMN_SEAT = "B"
Const COLUMNN_NAME = "C"
Const COLUMN_DEPT = "D"
Const COLUMN_EXTNO = "E"

Private Sheet As Worksheet
Private RowIndex As Long

Private Sub TxtSeatNo_Change()
  Dim seatno

  'clear the fields first
  Me.TxtName.value = Empty
  Me.TxtDept.value = Empty
  Me.TxtExtNo.value = Empty
  RowIndex = 0

  If Len(TxtSeatNo.value) Then
    Set Sheet = ThisWorkbook.Sheets(SHEET_DATA)

    On Error Resume Next

    ' get the seat number to either string or double
    seatno = TxtSeatNo.value
    seatno = CDbl(seatno)

    ' get the row index containing the SeatNo
    RowIndex = WorksheetFunction.match(seatno, _
                                       Sheet.Columns(COLUMN_SEAT), _
                                       0)
    On Error GoTo 0
  End If

  If RowIndex Then
    ' copy the values from the sheet to the text boxes
    Me.TxtName.value = Sheet.Cells(RowIndex, COLUMNN_NAME)
    Me.TxtDept.value = Sheet.Cells(RowIndex, COLUMN_DEPT)
    Me.TxtExtNo.value = Sheet.Cells(RowIndex, COLUMN_EXTNO)
  End If
End Sub

Private Sub BtCopy_Click()
  If RowIndex < 1 Then Exit Sub

  ' copy the current values to the cells pointed by the ref controls

  If Len(Me.RefName.value) Then _
    Range(Me.RefName.value) = Sheet.Cells(RowIndex, COLUMNN_NAME)

  If Len(Me.RefDept.value) Then _
    Range(Me.RefDept.value) = Sheet.Cells(RowIndex, COLUMN_DEPT)

  If Len(Me.RefExtNo.value) Then _
    Range(Me.RefExtNo.value) = Sheet.Cells(RowIndex, COLUMN_EXTNO)
End Sub

Private Sub BtlClose_Click()
  ' close the form
  Unload Me
End Sub

Upvotes: 4

Related Questions