Incorporating refedit into Vlookup userform - vba

I have a vlookup userform which autofills the details in the form based on the seat n°.
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

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:
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

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.

Related

VBA Excel assistance in userform refedit control

I have setup my userform perfectly so that when the user enters the date it shows in a label box in the userform it self.
All I'm struggling with is using my output frame as shown, which contains a refEdit control and a button. I am trying to have the date to be placed on any worksheet cell.
Image of my userform:
So far the code that I have come up with is the following:
Private Sub avgBtn_Click()
Dim range1 As String
Dim newdate As String
range1 = TextBox3.Value + "," + TextBox1.Value + " " + TextBox2.Value + "," + TextBox4.Value
newdate = range1
Label7.Caption = newdate
End Sub
Private Sub cancelBtn_Click()
Unload Task2
End Sub
Private Sub CommandButton1_Click()
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
End Sub
Private Sub UserForm_Click()
Unload UserForm1
End Sub
For the refedit control and command button I have come up with this code but it is giving me errors:
Sub CommandButton2_Click()
Dim myCell As Range
Set myCell = Nothing
On Error Resume Next
Set myCell = Range(Me.RefEdit1.Value).Areas(1).Cells(1)
myCell.value = Label7.Caption
End Sub
Would appreciate any feedback in regards to this code.

(Excel VBA) How to Show AutoComplete Feature of a ComboBox as a DropDown List

I would like the following code to add values to a combobox, then when the user inputs characters into the combobox, the dropdown feature of the combobox will show only those items which contain those characters, similarly to the way the Google Search Bar works.
(source: intersites.com)
Code Edit:
Option Explicit
Option Compare Text
Public LC As Long
Public Count As Integer
Dim ComboArray() As String
'Initializes the userform, and saves values from database into an array
Private Sub UserForm_Initialize()
LC = Cells(1, Columns.Count).End(xlToLeft).Column
ReDim ComboArray(1 To LC)
For Count = 1 To LC
ComboArray(Count) = Cells(1, Count).Value
Next Count
End Sub
'Prevents changes if the down key is pressed?
Private Sub ComboBox_SiteName_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Application.ScreenUpdating = False
End Sub
'Adds values to combobox if they contain the string input by user
Private Sub ComboBox1_Change()
Dim pos As Integer
Dim i As Integer
ComboBox1.Clear
For Count = 1 To LC
pos = InStr(1, ComboArray(Count), ComboBox1.Value)
If pos <> 0 Then
With ComboBox1
.AddItem Cells(1, Count)
End With
End If
Next Count
End Sub
Here is a simple example, which may need refinement for your purposes, but illustrates the general principles of using the KeyPress event to build a string of user input, and compare that to each item in the list, effectively filtering the list to values that start with the input string.
This needs some refinement to handle backspacing, deleting, etc., which I tried to do, but didn't get as far as I'd like.
Code:
Option Explicit
Dim cbList As Variant
Dim userInput$
'### USERFORM EVENTS
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 8, 48
'MsgBox "Backspace"
Debug.Print "Backspace"
If userInput <> "" Then
userInput = Left(userInput, Len(userInput) - 1)
End If
Case 46
'MsgBox "Delete"
Debug.Print "Delete"
userInput = Replace(userInput, ComboBox1.SelText, "")
End Select
End Sub
Private Sub UserForm_Activate()
Dim cl As Range
userInput = ""
For Each cl In Range("A1:A8")
Me.ComboBox1.AddItem cl.Value
Next
Me.ComboBox1.MatchRequired = False
cbList = Me.ComboBox1.List
End Sub
Private Sub UserForm_Terminate()
userInput = ""
End Sub
'#### END USERFORM EVENTS
'#### COMBOBOX EVENTS
Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Me.ComboBox1.List = cbList
' Capture the user input in module variable
userInput = userInput & Chr(KeyAscii)
Debug.Print "input: " & userInput
Debug.Print KeyAscii
Dim i As Long, itm
For i = Me.ComboBox1.ListCount - 1 To 0 Step -1
itm = Me.ComboBox1.List(i)
If Not StartsWith(CStr(itm), userInput) Then
Me.ComboBox1.RemoveItem i
End If
Next
If Me.ComboBox1.ListCount = 0 Then
Me.ComboBox1.List = cbList
Else
Me.ComboBox1.List = Me.ComboBox1.List
End If
Me.ComboBox1.DropDown
End Sub
'#### END COMBOBOX EVENTS
'#### HELPER FUNCTIONS
Function StartsWith(imtVal$, inputStr$, Optional caseSensitive As Boolean = False)
', Optional caseSensitive As Boolean = False
'If Not caseSensitive Then
imtVal = LCase(imtVal)
inputStr = LCase(inputStr)
'End If
StartsWith = VBA.Strings.Left(imtVal, Len(inputStr)) = inputStr
End Function
'#### END HELPER FUNCTIONS

Set starting point for UsedRange

I have a combobox drop down that populates items from a list, with a function to filter to dropdown options by characters type in the combobox gathered by the following code
Option Explicit
Private cLstPrior As Variant
Private Sub Worksheet_SelectionChangePrior(ByVal Target As Range)
cLstPrior = Application.Transpose(Database.Columns("1:1").SpecialCells(xlCellTypeConstants, 23)) 'set module-level variable
Tool.priorCmb.List = cLstPrior 'initialize ComboBox to range Col A (UsedRange only)
Tool.priorCmb.ListIndex = -1 'set ComboBox value to empty
End Sub
Private Sub priorCmb_Change()
filterComboListPrior Tool.priorCmb, cLstPrior
End Sub
Private Sub priorCmb_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Tool.priorCmb.DropDown
End Sub
Private Sub priorCmb_GotFocus() 'or _MouseDown()
Tool.priorCmb.DropDown
End Sub
Public Sub filterComboListPrior(ByRef cmbPrior As ComboBox, ByRef dLstPrior As Variant)
Dim itmPrior As Variant, lstPrior As String, selPrior As String
Application.EnableEvents = False
With cmbPrior
selPrior = .Value
If IsEmpty(cLstPrior) Then cLstPrior = Worksheets("Database").Columns("1:1").SpecialCells(xlCellTypeConstants, 23)
For Each itmPrior In cLstPrior
If Len(itmPrior) > 1 Then If InStr(1, itmPrior, selPrior, 1) Then lstPrior = lstPrior & itmPrior & "||"
Next
If Len(lstPrior) > 1 Then .List = Split(Left(lstPrior, Len(lstPrior) - 2), "||") Else .List = dLstPrior
End With
Application.EnableEvents = True
End Sub
The data the combobox needs to populate with is all from Column 1 in this case, any cell with characters in it.
The issue is that there are blank cells at A1 and A2, so blank entries populate the combobox dropdown later on. I am trying to force the range to only include cells with values in them, but am getting an application-defined or object-defined error at If IsEmpty(cLstPrior) Then cLstPrior = Worksheets("Database").Columns("1:1").SpecialCells(xlCellTypeConstants, 23)
I can't seem to figure this out. Also, is my Application.Transpose behavior correct or not needed?
Instead of:
Database.UsedRange.Rows(2)
Try:
Database.Range(Database.Cells(2,2),Database.Cells(Database.UsedRange.Rows.Count, 2))
May be best to use specialcells, and loop through the cells that have values.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rRng As Range, c As Range, ws As Worksheet
Set ws = Sheets("Database")
Me.ComboBox1.Clear
Set rRng = ws.Rows("2:2").SpecialCells(xlCellTypeConstants, 23)
For Each c In rRng.Cells
Me.ComboBox1.AddItem c
Next c
End Sub
Use Intersect to exclude columns
With Worksheets("Database")
Set rng = Application.Intersect(.UsedRange.Rows(2), .Cells.Resize(.Columns.Count - 1).Offset(1))
End With
Change the line in question to the newly defined range
If IsEmpty(cLst) Then cLst = rng

VBA Refresh UserForm ListBox Data when source changes

Hi I have encountered problem with my listbox data in my Userform
When I try to change the source file where my listbox connected it doesn't seems to change
It was showing good data at first but when I try to click RUN DATE button
It doesn't go with the Value in my Range that is being set as My key for sorting
Here is my code for RUN DATE BUTTON for sorting Ascending and Descending
Private Sub CommandButton1_Click()
Application.EnableEvents = False
Worksheets("combobox_value").Activate
Dim strDataRange As Range
Dim keyRange As Range
Set strDataRange = Range("I2:L4")
Set keyRange = Range("I2:I4")
If Range("M2").Value = "D" Then
strDataRange.Sort Key1:=keyRange, Order1:=xlDescending
Range("M2").Value = "A"
Else
strDataRange.Sort Key1:=keyRange, Order1:=xlAscending
Range("M2").Value = "D"
End If
Application.EnableEvents = True
End Sub
And this is how I initialize the value in my listbox
Private Sub UserForm_Initialize()
'set ListBox properties on initialization of UserForm
Set sht = ThisWorkbook.Worksheets("combobox_value")
lastRow_combobox_column = sht.Cells(sht.Rows.Count, "I").End(xlUp).Row
With ListBox1
.ColumnCount = 4
.ColumnWidths = "100"
.ColumnHeads = False
.ControlTipText = True
End With
'Load Worksheet Range directly to a ListBox:
Dim var As Variant
var = Sheets("combobox_value").Range("I2:L" & lastRow_combobox_column)
Me.ListBox1.List = var
End Sub
Is there a way to refresh my listbox? Listbox1.refresh something like that?
Note: I don't need to close my Userform and open again to see the updated listbox
so while the Userform is in active mode(Open) I can directly update the listbox value..
Thanks
Instead of using var and assigning the data to List from var, you can use Named Range of data in the sheet and assign the property
ListBox1.RowSource = "Name of the Range"
Every time you want to refresh the listbox just use the above assignment in your code and it will work. If you find any difficulty please let me know.
You could add a refresh procedure, then call it in your OnClick event procedure for the button.
Note, I haven't tested this code, but it should do what your original question asked.
Private Sub UserForm_Initialize()
'set ListBox properties on initialization of UserForm
Set sht = ThisWorkbook.Worksheets("combobox_value")
lastRow_combobox_column = sht.Cells(sht.Rows.Count, "I").End(xlUp).Row
With ListBox1
.ColumnCount = 4
.ColumnWidths = "100"
.ColumnHeads = False
.ControlTipText = True
End With
RefreshListbox
End Sub
Private Sub CommandButton1_Click()
Application.EnableEvents = False
Worksheets("combobox_value").Activate
Dim strDataRange As Range
Dim keyRange As Range
Set strDataRange = Range("I2:L4")
Set keyRange = Range("I2:I4")
If Range("M2").Value = "D" Then
strDataRange.Sort Key1:=keyRange, Order1:=xlDescending
Range("M2").Value = "A"
Else
strDataRange.Sort Key1:=keyRange, Order1:=xlAscending
Range("M2").Value = "D"
End If
Application.EnableEvents = True
RefreshListbox
End Sub
Private Sub RefreshListbox()
Me.ListBox1.Clear
'Load Worksheet Range directly to a ListBox:
Dim ListRange As Range
ListRange = Sheets("combobox_value").Range("I2:L" & lastRow_combobox_column)
Me.ListBox1.List = ListRange
End Sub

Update sheet with data from userform

I have a table and I have the form I built.
the user pick a name and surname from the table by the combobox in form
the user need to choose from combobox "yes/no" about this name
I need a vba code (excel) so that it can find the name (after the user picked it) in the table
and then update the yes/no column by the correct row.
I created a module and added this:
Option Explicit
Public Sub update_sheet(workername As String)
'--> If the user was selected on the form update column F to Yes
Dim ws As Worksheet
Dim rowno As Long
Set ws = Sheets("workers")
With ws
rowno = .Range("C:C").Find(workername).Row
.Cells(rowno, 6).Value = "Yes"
End With
End Sub
On the form code:
Private Sub cb_select_change()
Call update_sheet(cb_select.Value)
End Sub
where your combo box is called cb_select
You'll need to do some work on this to make it into what you need, but it should get you started:
Private Sub CommandButton1_Click()
Dim rng_ToSearch As Excel.Range
Dim rng_Found As Excel.Range
On Error GoTo ErrorHandler
'Change this to the range that contains your names. I'm assuming that
'it's a single column and has the Yes/No column alongside.
Set rng_ToSearch = Sheet1.Range("MyTable_Names")
'Change the What argument to reflect the name of your form's
'control.
Set rng_Found = rng_ToSearch.Find(What:=Me.ComboBox1.Value, _
After:=rng_ToSearch.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'This shouldn't happen if you've populated the name selection
'box correctly and have not allowed users to add to it.
'This is left as an exercise for the reader.
If rng_Found Is Nothing Then
Err.Raise vbObjectError + 2000, , "Either the selected name was " _
& "not found in the list, or no selection was made."
End If
'Again, change the control name to your own.
rng_Found.Offset(0, 1) = Me.ComboBox2.Value
ExitPoint:
On Error Resume Next
Set rng_ToSearch = Nothing
Set rng_Found = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
MsgBox "Error in updating users: " & Err.Number & vbCrLf & Err.Description
Resume ExitPoint
End Sub
THIS IS MY CODE SO FAR
Private Sub RefEdit1_BeforeDragOver(Cancel As Boolean, ByVal Data As msforms.DataObject, ByVal x As stdole.OLE_XPOS_CONTAINER, ByVal y As stdole.OLE_YPOS_CONTAINER, ByVal DragState As msforms.fmDragState, Effect As msforms.fmDropEffect, ByVal Shift As Integer)
End Sub
Private Sub ClsFrmE_Click()
Unload Me
End Sub
Private Sub cmdAdd_Click()
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("workers")
'???÷? ?? ?????? ?????
If Trim(Me.cmbWN.Value) = "" Then
Me.cmbWN.SetFocus
MsgBox "???? ?? ????"
Exit Sub
End If
If Trim(Me.tbDate.Value) = "" Then
Me.tbDate.SetFocus
MsgBox "???? ????? ?????"
Exit Sub
End If
'copy the data to the database
'use protect and unprotect lines,
' with your password
' if worksheet is protected
With ws
' .Unprotect Password:="password"
If Trim(Me.dNdcmb.Value) = "????" Then
.Cells(lRow, 6).Value = 1
Else
.Cells(lRow, 6).Value = 0
End If
.Cells(lRow, 7).Value = Me.tbDate.Value
'.Cells(lRow, 2).Value = Me.cboPart.List(lPart, 1)
' .Protect Password:="password"
End With
'clear the data
Me.cmbWN.Value = ""
Me.tbDate.Value = ""
Me.cmbWN.SetFocus
ActiveWorkbook.Save
End Sub
Private Sub UserForm_Initialize()
Dim cFullName As Range
Dim cDnd As Range
Dim ws As Worksheet
Set ws = Worksheets("workers")
For Each cFullName In ws.Range("??????")
With Me.cmbWN
.AddItem cFullName.Value
.List(.ListCount - 1, 1) = cFullName.Offset(0, 1).Value
End With
Next cFullName
For Each cDnd In ws.Range("??????????")
With Me.dNdcmb
.AddItem cDnd.Value
End With
Next cDnd
Me.dNdcmb.Text = Me.dNdcmb.List(Me.dNdcmb.ListCount - 2)
Me.cmbWN.SetFocus
End Sub