VBA Refresh UserForm ListBox Data when source changes - vba

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

Related

Excel VBA Userform CheckBox check mark does not appear

I have created an UserForm in Excel. The UserForm has a ListBox and a CheckBox added to it.
I have written VBA code to populate the ListBox with data in the 1st column of the UserForm_Data worksheet. I am attempting to add a Select All CheckBox to the UserForm. When I click on the CheckBox once, the check mark does not appear but the If Me.CheckBox.Value = True section of the Checkbox1_Change event is executed and all the items in the ListBox are selected. The check mark appears only when I click the CheckBox the second time. The Excel VBA code and an image of the UserForm are attached.
Option Explicit
Private Sub ListBox1_Change()
Dim i As Long
If CheckBox1.Value = True Then
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = False Then
Me.CheckBox1.Value = False
End If
Next i
End If
End Sub
Private Sub CheckBox1_Change()
Dim i As Long
If Me.CheckBox1.Value = True Then
With Me.ListBox1
For i = 0 To .ListCount - 1
.Selected(i) = True
Next i
End With
Else
i = 0
End If
End Sub
Private Sub UserForm_Initialize()
Dim rng1 As Range
Dim ws1 As Worksheet
Dim i, lastRow As Long
Dim list1 As Object
Dim string1 As String
Dim array1 As Variant
Set list1 = CreateObject("System.Collections.ArrayList")
Set ws1 = ThisWorkbook.Worksheets("UserForm_data")
lastRow = ws1.UsedRange.Rows.Count
Me.ListBox1.Clear
For i = 2 To lastRow
string1 = CStr(ws1.Cells(i, 1).Value)
If Not list1.Contains(string1) Then
list1.Add string1
End If
Next i
array1 = list1.ToArray
Me.Caption = "UserForm1"
Me.ListBox1.list = array1
Me.ListBox1.MultiSelect = 1
Me.CheckBox1.Value = False
End Sub
There are two steps you can take to address this:
There's a chance that simply adding a DoEvents at the end of the CheckBox1_Change event will force the redraw.
If that doesn't work, add the following line just above the DoEvents and test it again... this encourages a screen update...
Application.WindowState = Application.WindowState
One approach is to use global flags to toggle on and off the control event handlers. Here is what the updated events would look like:
Option Explicit
Private Sub ListBox1_Change()
Dim i As Long
If Not AllowListBoxEvents Then Exit Sub
AllowCheckBoxEvents = False
If CheckBox1.Value = True Then
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = False Then CheckBox1.Value = False
Next i
End If
AllowCheckBoxEvents = True
End Sub
Private Sub CheckBox1_Change()
Dim i As Long
If Not AllowCheckBoxEvents Then Exit Sub
AllowListBoxEvents = False
If CheckBox1.Value = True Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = True
Next i
End If
AllowListBoxEvents = True
End Sub
Make sure you set the "Allow" variables to True in the Initialize event.

Autocomplete code for a worksheet in Excel not working in other worksheets using VB

My goal was to make autocomplete active for dropdowns and I have achieved it for a single worksheet but duplicating the code to other worksheets is not working.
I started by creating a combo Box on the initial worksheet containing the drop downs and then made the following changes-
Changed the name to TempCombo in the Name field
Selected 1-fmMatchEntryComplete in the MatchEntry field;
I then inserted the following code for that worksheet:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2017/8/15
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Set xWs = Application.ActiveSheet
On Error Resume Next
Set xCombox = xWs.OLEObjects("TempCombo")
With xCombox
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
If Target.Validation.Type = 3 Then
Target.Validation.InCellDropdown = False
Cancel = True
xStr = Target.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
If xStr = "" Then Exit Sub
With xCombox
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = xStr
.LinkedCell = Target.Address
End With
xCombox.Activate
Me.TempCombo.DropDown
End If
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal
`Shift As Integer)`
Select Case KeyCode
Case 9
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub
This implementation works perfectly for that sheet but when i attempt to use the same code on another worksheet on the same file the autocomplete function doesn't work.
I attempted modification of the combobox name on sheet2 to TempCombo2 and changed the following line:
Set xCombox = xWs.OLEObjects("TempCombo")
to
Set xCombox = xWs.OLEObjects("TempCombo2")
The autocomplete function fails to work on sheet 2 even though no error is thrown.
This is a pretty interesting idea, I like it.
I was able to get this to work on multiple sheets with the following modifications:
Removed Cancel = True, this line was throwing an error and Cancel is not an argument in Worksheet_SelectionChange; I don't think this is doing anything.
Copied the code to the second sheet's code module (it has to be in each sheet module that you want it to run on)
updated Set xCombox = xWs.OLEObjects("TempCombo") to Set xCombox = xWs.OLEObjects("TempCombo2")
Me.TempCombo.DropDown updated to Me.TempCombo2.DropDown since that is what I named the combo box on the second sheet
Also, not a change as much as an assumption, it seems it only works with the ActiveX controls, so I assume that's what you are using when you add the new box.
As a follow up I was able to get it to work using the workbook module as long as the combo box is named "TempCombo" on all sheets (you have to add a combobox named "TempCombo" to each sheet). Going this route, you only need the code once, on the workbook module , and it uses the combo box that is local to each sheet.
TO TEST - In a new workbook: add list validation to a range using a range reference, put some values in the list range, add an ActiveX combobox to the sheet and name it "TempCombo", put the following code in the workbook module, then click anywhere in the range that has the list validation enabled.
One other note, make sure you aren't still in design mode on the developer tab!
Option Explicit
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Update by Extendoffice: 2017/8/15
Dim xCombox As OLEObject
Dim xStr As String
Dim xWs As Worksheet
Set xWs = Sh
On Error Resume Next
Set xCombox = xWs.OLEObjects("TempCombo")
With xCombox
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
If Target.Validation.Type = 3 Then
Target.Validation.InCellDropdown = False
'Cancel = True
xStr = Target.Validation.Formula1
xStr = Right(xStr, Len(xStr) - 1)
If xStr = "" Then Exit Sub
With xCombox
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = xStr
.LinkedCell = Target.Address
End With
xCombox.Activate
Sh.TempCombo.DropDown
End If
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case 9
Application.ActiveCell.Offset(0, 1).Activate
Case 13
Application.ActiveCell.Offset(1, 0).Activate
End Select
End Sub

VBA - Loop Option Buttons & Check Boxes on a UserForm

I am trying to display specific data in a specific worksheet using a user form.
There is one command button on the user form - Next - that takes the users preferences (option button chosen), opens a new workbook, and displays the desired data (check boxes chosen) in the specific workbook.
There are 6 option buttons and and 6 check boxes. The worksheet that opens is based on the option button preference and depending on what was chosen in the check boxes, the data associated to that topic will display in the worksheet.
How can i loop options buttons and check boxes on a userform and capture which are "selected"?
The data displayed (in a worksheet) from the chosen check boxes depends on the option button chosen e.g. if I chose Finance (option button), and then I chose Photos and Videos (check boxes), I'd like to display data specific to those selections on the appropriate worksheet.
Here is what I have so far:
Private Sub cmdNext_Click()
'declare variables
Dim strFinancial As String, strFamily As String, strSadness As String,
strSchool As String, strRelationship As String, strTime As String
Dim shtFinancial As Worksheet, shtFamily As Worksheet, shtSadness As
Worksheet, shtSchool As Worksheet, shtRelationship As Worksheet,
shtTime As Worksheet, shtData As Worksheet
shtFinancial = Workbooks("PROJECT.xlsm").Worksheets("Financial")
shtTime = Workbooks("PROJECT.xlsm").Worksheets("Time")
shtFamily = Workbooks("PROJECT.xlsm").Worksheets("Family")
shtSadness = Workbooks("PROJECT.xlsm").Worksheets("Sadness")
shtSchool = Workbooks("PROJECT.xlsm").Worksheets("School")
shtRelationship = Workbooks("PROJECT.xlsm").Worksheets("Relationship")
shtData = Workbooks("PROJECT.xlsm").Worksheets("Data")
'set option button selection to string
strFinancial = obFinancial.Value
strFamily = obFamily.Value
strSadness = obSadness.Value
strSchool = obSchool.Value
strRelationship = obRelationship.Value
strTime = obTime.Value
'activate worksheet of chosen stressor (option button)
Select Case True
Case strTime = True
shtTime.activate
Case strFinancial = True
shtFinancial.activate
Case strFamily = True
shtFamily.activate
Case strSadness = True
shtSadness.activate
Case strSchool = True
shtSchool.activate
Case strRelationship = True
shtRelationship.activate
End Select
'ADVICE
'loop through checkboxes HOW ????
'display advice according to option button chosen
If obFinancial.Value = True And Me.cbAdvice.Value = True Then
shtData.Range("A1:A10").Copy Destination:=Sheets("Financial").Range("A1:A10")
End If
If obSadness.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A21:A30").Copy Destination:=Sheets("Sadness").Range("A1:A10")
End If
If obSchool.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A31:A40").Copy Destination:=Sheets("School").Range("A1:A10")
End If
If obRelationship.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A41:A50").Copy Destination:=Sheets("Relationship").Range("A1:A10")
End If
If obTime.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A51:A60").Copy Destination:=Sheets("Time").Range("A1:A10")
End If
End Sub
Here is the userform:
Yes, it's little bit unclear what you trying to do...
Following is a general example how you might loop through CheckBoxes and OptionButtons:
Private Sub CommandButton1_Click()
Dim c As Control, str As String
For Each c In UserForm1.Controls
If TypeName(c) = "CheckBox" Or TypeName(c) = "OptionButton" Then
str = str & IIf(c = True, c.Caption & vbCrLf, "")
End If
Next c
MsgBox "Selected controls" & vbCrLf & str
End Sub
It is a little difficult to see exactly what you want but I can't help wondering if you're looking at VBA in the wrong way. VBA is an event-driven language, meaning that you can capture most interactions the user has with your programme. This should do away with the need to loop through your controls each time, as you could just log selections as the user makes them.
The most obvious thing to do would be to create some kind of sheet/range map, say in a Collection, and then just retrieve the objects you want based on a selection key. The code below is a skeleton of how you could do it - obviously you'd need to expand and adjust it to suit your own needs.
First declare a few variables at module-level (ie very top of your page):
Option Explicit
Private mRangeMap As Collection
Private mOptKey As String
Private mCboxKey As String
Then build your map. In the example below, I've done this in the Userform_Initialize routine, but you could call it anywhere:
Private Sub UserForm_Initialize()
Dim shtRngPair(1) As Object
'Build the range map.
Set mRangeMap = New Collection
With ThisWorkbook 'use name ofyour workbook
Set shtRngPair(0) = .Worksheets("Financial")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A1:A10")
mRangeMap.Add shtRngPair, "Fin|Adv"
Set shtRngPair(1) = .Range("A11:A20")
mRangeMap.Add shtRngPair, "Fin|Pho"
End With
Set shtRngPair(0) = .Worksheets("Sadness")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A21:A30")
mRangeMap.Add shtRngPair, "Sad|Adv"
Set shtRngPair(1) = .Range("A31:A40")
mRangeMap.Add shtRngPair, "Sad|Pho"
End With
Set shtRngPair(0) = .Worksheets("School")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A41:A50")
mRangeMap.Add shtRngPair, "Sch|Adv"
Set shtRngPair(1) = .Range("A51:A60")
mRangeMap.Add shtRngPair, "Sch|Pho"
End With
End With
End Sub
Now you just need the code to store the user inputs. I just have 3 option buttons and 2 checkboxes for an example:
Private Sub cboxAdvice_Click()
mCboxKey = "Adv"
End Sub
Private Sub cboxPhotos_Click()
mCboxKey = "Pho"
End Sub
Private Sub obFinancial_Click()
mOptKey = "Fin"
End Sub
Private Sub obSadness_Click()
mOptKey = "Sad"
End Sub
Private Sub obSchool_Click()
mOptKey = "Sch"
End Sub
Finally, copy the data when the user hits the Next button:
Private Sub cmdNext_Click()
Dim key As String
Dim shtRngPair As Variant
Dim v As Variant
'Create the key
key = mOptKey & "|" & mCboxKey
'Find the relevant range
On Error Resume Next
shtRngPair = mRangeMap(key)
On Error GoTo 0
'Test if the key is valid
If IsEmpty(shtRngPair) Then
MsgBox "Selection [" & key & "] is invalid."
Exit Sub
End If
'Copy the data
v = shtRngPair(1).Value2
With shtRngPair(0)
.Cells.Clear
.Range("A1").Resize(UBound(v, 1), UBound(v, 2)).Value = v
.Activate
End With
End Sub
Update as per OP's comment
Below is the updated code which iterates your checkbox selections. You'd need to add additional code if you wanted them in a specific order:
Option Explicit
Private mRangeMap As Collection
Private mCboxKeys As Collection
Private mOptKey As String
Private Sub cboxAdvice_Change()
UpdateCheckboxList "Adv", cboxAdvice.Value
End Sub
Private Sub cboxPhotos_Change()
UpdateCheckboxList "Pho", cboxPhotos.Value
End Sub
Private Sub UpdateCheckboxList(ele As String, addItem As Boolean)
'Add or remove the item
If addItem Then
mCboxKeys.Add ele, ele
Else
mCboxKeys.Remove ele
End If
End Sub
Private Sub obFinancial_Click()
mOptKey = "Fin"
End Sub
Private Sub obSadness_Click()
mOptKey = "Sad"
End Sub
Private Sub obSchool_Click()
mOptKey = "Sch"
End Sub
Private Sub cmdNext_Click()
Dim key As String
Dim shtRngPair As Variant, v As Variant, cbk As Variant
Dim rng As Range
Dim initialised As Boolean
For Each cbk In mCboxKeys
'Create the key
key = mOptKey & "|" & cbk
'Find the relevant range
On Error Resume Next
shtRngPair = mRangeMap(key)
On Error GoTo 0
If IsEmpty(shtRngPair) Then
'Test if the key is valid
MsgBox "Selection [" & key & "] is invalid."
Else
If Not initialised Then
With shtRngPair(0)
.Cells.Clear
.Activate
Set rng = .Range("A1")
End With
initialised = True
End If
'Copy the data
v = shtRngPair(1).Value2
rng.Resize(UBound(v, 1), UBound(v, 2)).Value = v
'Offset range
Set rng = rng.Offset(UBound(v, 1))
End If
Next
End Sub
Private Sub UserForm_Initialize()
Dim shtRngPair(1) As Object
'Initialise the collections
Set mRangeMap = New Collection
Set mCboxKeys = New Collection
'Build the range map.
With ThisWorkbook 'use name ofyour workbook
Set shtRngPair(0) = .Worksheets("Financial")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A1:A10")
mRangeMap.Add shtRngPair, "Fin|Adv"
Set shtRngPair(1) = .Range("A11:A20")
mRangeMap.Add shtRngPair, "Fin|Pho"
End With
Set shtRngPair(0) = .Worksheets("Sadness")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A21:A30")
mRangeMap.Add shtRngPair, "Sad|Adv"
Set shtRngPair(1) = .Range("A31:A40")
mRangeMap.Add shtRngPair, "Sad|Pho"
End With
Set shtRngPair(0) = .Worksheets("School")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A41:A50")
mRangeMap.Add shtRngPair, "Sch|Adv"
Set shtRngPair(1) = .Range("A51:A60")
mRangeMap.Add shtRngPair, "Sch|Pho"
End With
End With
End Sub

VBA Excel Button Macro Error

I am programmatically placing a button on a worksheet and it places fine, however when I click it i get an error saying "Cannot run the macro. The macro may not be available in this workbook or all macros may be disabled". I believe I've set it up fine but here is my code if anyone spots anything would greatly appreciate it.
Sub ButtonGenerator()
Application.ScreenUpdating = False
Dim wsCRC As Worksheet
Set wsCRC = Worksheets("CRC")
Dim lcolumncrc As Long
lcolumncrc = CRC.LastColumnInCRC
'Button Declarations
Dim ShowHideDates As Button
wsCRC.Buttons.Delete
'Show/Hide Dates Button Set Up
Dim SHDrange As Range
Set SHDrange = wsCRC.Range(Cells(5, lcolumncrc + 2), Cells(5, lcolumncrc + 4))
Set ShowHideDates = wsCRC.Buttons.Add(SHDrange.Left, SHDrange.Top, SHDrange.Width, SHDrange.Height)
With ShowHideDates
.OnAction = "wsCRC.SHDbtn"
.Caption = "Show Hidden Date Columns"
.Name = "ShowHideDates"
End With
Application.ScreenUpdating = True
End Sub
Sub SHDbtn()
Dim wsCRC As Worksheet
Set wsCRC = Worksheets("CRC")
Dim ShowHideDates As Button
Dim CurrentDateColumn As Long
CurrentDateColumn = GetTodaysDateColumn()
ActiveSheet.Unprotect
If ShowHideDates.Caption = "Hide Old Date Columns" Then
wsCRC.Range(wsCRC.Cells(5, 10), wsCRC.Cells(5, CurrentDateColumn - 6)).EntireColumn.Hidden = True
ShowHideDates.Caption = "Show Hidden Date Columns"
Else
wsCRC.Range(wsCRC.Cells(5, 10), wsCRC.Cells(5, CurrentDateColumn - 6)).EntireColumn.Hidden = False
ShowHideDates.Caption = "Hide Old Date Columns"
End If
ActiveSheet.Protect
End Sub
You're referring to a worksheet by the label you've given it within your code, not as a sheet itself.
Try changing:
.OnAction = "wsCRC.SHDbtn"
to
.OnAction = "CRC.SHDbtn"
or even
.OnAction = "SHDbtn"

Incorporating refedit into Vlookup userform

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.