This is a question mainly to understand and learn, then to find a solution, since i know what causes the problem and made a workaround.
I get Run-time error '-2147417848 (80010108)': Method 'Value' of object 'Range' failed.
I have a main UserForm with a ListBox, it gets filled from a table. Then i have a secondary UserForm to make new entries in said table. That table is on my sheet shData("Daten") and is called "mainData". If just run the secondary form to make new entry, all is fine. But if i start the secondary form from main form, i get the error.
This is the code in main form.
Private Sub newEntryButton_Click()
newEntry.Show
End Sub
Private Sub UserForm_Activate()
mainListUpdate
End Sub
This is the code in secondary form
Private Sub doneButton_Click()
Dim n As Long
n = cRow + 1
shData.Range("A" & n).Value = nameBox.Value
shData.Range("B" & n).Value = paraBox.Value
shData.Range("C" & n).Value = hStartBox.Value
shData.Range("D" & n).Value = bdayBox.Value
If OptionButtonStat.Value = True Then
shData.Range("E" & n).Value = "Ja"
shData.Range("G" & n).Value = statPlaceBox.Value
ElseIf OptionButtonAmb.Value = True Then
shData.Range("F" & n).Value = "Ja"
End If
Me.Hide
End Sub
Private Sub OptionButtonStat_Change()
If OptionButtonStat.Value = True Then
Me.statPlaceBox.Visible = True
Me.statPlaceLab.Visible = True
Else
Me.statPlaceBox.Visible = False
Me.statPlaceLab.Visible = False
End If
End Sub
Public Sub UserForm_Activate()
Me.statPlaceBox.Visible = False
Me.statPlaceLab.Visible = False
End Sub
and this is the code in a module.
Public cRow As Long
Public cCol As Long
Public Sub mainListUpdate()
If shData.FilterMode = True Then
shData.ShowAllData
End If
cRow = shData.Range("A1").CurrentRegion.Rows.Count
cCol = shData.Range("A1").CurrentRegion.Columns.Count
formMain.listMain.ColumnCount = cCol
formMain.listMain.ColumnHeads = True
formMain.listMain.RowSource = "mainData"
End Sub
The error occurs on the following line in secondary form code: shData.Range("A" & n).Value = nameBox.Value. If i change formMain.listMain.RowSource = "mainData" in the module code to formMain.listMain.RowSource = "Daten!A2:G", the problem disappears. Again, the code works fine with the table as RowSource, if i just use the secondary form, just need to add cRow = shData.Range("A1").CurrentRegion.Rows.Count.
I hope, i explained it well enough. Can somebody please explain, why i have this problem? It was very frustrating to search for the issue and i really would like to use the original code.
Related
Good Day People,
im kinda new to VBA.
Im trying to make a time and attandance.
Im actually pretty far, but unforntuanly i ran into a problem.
I use 2 Userforms. One where you get with your id to your sheet and can then clock in or clock out on the userform2.
When they clocked in or clocked it, it goes back to the first form. Unfornuatly the form doesnt work then anymore. I tried loading, hide, show, exit sub, searched the internet but cant find a solution.
Maybe im doing something wrong, that the modul / Userform doesnt work anymore.
Im thankfull for any help.
Dont mind Names of Strings and stuff, its just a test before i do the real one.
Im using the modulobject for the code. Looks better for me
So im refering in Userform1 Objects to a sub in the modullib.
Modul1:
Function DoesSheetExists(sh As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sh)
On Error GoTo 0
If Not ws Is Nothing Then DoesSheetExists = True
End Function
Sub ScanID()
Dim MitarbeiterWS As Worksheet
Dim MitarbeiterID As Range
Dim MitarbeiterIDstring As String
Dim MitarbeiterName As String
ThisWorkbook.Sheets("MitarbeiterID").Activate
MitarbeiterIDstring = UserForm1.TextBox1.Value
Set MitarbeiterID = Range("A1:A30").Find(What:=MitarbeiterIDstring)
If Not MitarbeiterID Is Nothing Then
MitarbeiterName = MitarbeiterID.Offset(, 1).Value
UserForm1.Label1 = MitarbeiterName
If Not DoesSheetExists(MitarbeiterName) Then
If Not MitarbeiterName = "" Then
Sheets("Example").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = MitarbeiterName
Unload UserForm1
UserForm2.Show
MitarbeiterID.Select
Else
End If
Else
ThisWorkbook.Sheets(MitarbeiterName).Activate
Unload UserForm1
UserForm2.Show
End If
Else
End If
End Sub
Modul2
Sub Eincloggen()
Dim Einspalte As Range
Set Einspalte = Range("A1").End(xlDown)
'wenn zum ersten mal eingeclockt
If Einspalte.Offset(, 1).Value = "" Then
If Einspalte.Value = "Clocked In" Then
Einspalte.Offset(1, 0).Value = Now
Else
MsgBox "Erst Raus"
End If
Else
Einspalte.Offset(1, 0).Value = Now
Unload UserForm2
UserForm2.Hide
UserForm1.Show
End If
End Sub
Sub Auscloggen()
Dim Einspalte As Range
Dim Ausspalte As Range
Dim Pausenspalte As Range
Dim Stundenspalte As Range
Set Einspalte = Range("A1").End(xlDown)
Set Ausspalte = Range("B1").End(xlDown)
Set Pausenspalte = Range("C1").End(xlDown)
Set Stundenspalte = Range("D1").End(xlDown)
If Ausspalte.Offset(1, -1).Value = "" Then
MsgBox "Erst Rein"
Else
Ausspalte.Offset(1, 0).Value = Now
If Not Ausspalte.Offset(1, 0).Value = "" Then
Stundenspalte.Offset(1, 0).Value = (Ausspalte.Offset(1, 0).Value) - (Einspalte.Value)
Stundenspalte.Offset(1, 0).NumberFormat = "hh:mm"
Unload UserForm2
UserForm2.Hide
UserForm1.Show
End If
End If
End Sub
So I have a form called "Print_Form" that has 20 checkboxes that upon form initialization take on the sheet names of the first 20 sheets of my workbook.
(no issue with the UserForm_Initialize() sub, this works fine)
Private Sub UserForm_Initialize()
CheckBox1.Caption = Sheets(1).Name
CheckBox2.Caption = Sheets(2).Name
CheckBox3.Caption = Sheets(3).Name
CheckBox4.Caption = Sheets(4).Name
CheckBox5.Caption = Sheets(5).Name
CheckBox6.Caption = Sheets(6).Name
CheckBox7.Caption = Sheets(7).Name
CheckBox8.Caption = Sheets(8).Name
CheckBox9.Caption = Sheets(9).Name
CheckBox10.Caption = Sheets(10).Name
CheckBox11.Caption = Sheets(11).Name
CheckBox12.Caption = Sheets(12).Name
CheckBox13.Caption = Sheets(13).Name
CheckBox14.Caption = Sheets(14).Name
CheckBox15.Caption = Sheets(15).Name
CheckBox16.Caption = Sheets(16).Name
CheckBox17.Caption = Sheets(17).Name
CheckBox18.Caption = Sheets(18).Name
CheckBox19.Caption = Sheets(19).Name
CheckBox20.Caption = Sheets(20).Name
End Sub
Where I am running into issues is in the following sub routine when the user clicks the print button in the form. The intention behind this button is to print all the sheets that the user has selected (i.e. the sheets that had their corresponding checkbox checked by the user). Currently, when I select multiple checkboxes and then click on the print button I get the following error; "Run-Time error '9': Subscript out of range.
Private Sub cmdPrint_Click()
Dim i As Integer
Dim cb As MSForms.Control
Dim SheetArray() As String
i = 0
'Search form for a checkbox
For Each cb In Me.Controls
i = i + 1
ReDim Preserve SheetArray(i)
'If the control is a checkbox
If TypeName(cb) = "CheckBox" Then
'and the checkbox is checked
If cb.Value = True Then
'Add the sheet to the sheet array (sheet name string was already added to the checkbox property caption; see UserForm_initialize)
SheetArray(i) = cb.Caption
End If
End If
Next cb
'Print Sheet Array
Sheets(SheetArray()).PrintOut
Unload Me
End Sub
If anyone has any ideas that would help me get this to work I would be very appreciative. Thank you in advance. :)
Try this:
Private Sub UserForm_Initialize()
Dim i As Long
For i = 1 To 20 'less typing....
Me.Controls("CheckBox" & i).Caption = Sheets(i).Name
Next i
End Sub
Private Sub cmdPrint_Click()
Dim i As Integer, s As String, sep
For i = 1 To 20
With Me.Controls("CheckBox" & i)
If .Value Then
s = s & sep & .Caption
sep = "," 'add delimiter after first item
End If
End With
Next i
Sheets(Split(s, ",")).PrintOut
Unload Me
End Sub
Task:
I work in Excel2013. I tried to write in VBA a userform to add parameters into dynamic named ranges. All named ranges are held in one sheet and were created using insert>table. I select the range, show existing values and get the new value. All went well untill I actually got to adding value to the range.
Problem:
Excel shuts down most of the time when I try to run the UserForm. Saying:
"Run-time error '-2147417848 (80010108)' Method X of object 'Range' failed"
with different methods ('_Default' last time I checked) at different stages of me breaking code down.
Symtoms:
After this line as I found I get the error:
Cells(y, x) = v
where y and x are integers and v a string I get from the userform. During the debug I checked all values are defined and have values. Moreover, Immediate window with the same numbers input manually (not as variables), works!
It mostly doesn't work, though it did follow through doing the job.
If somone could tell the reason why it breaks it would be greatly appreciated!
Some of the captions and potential values are in Unicode in case it matters, though I tried putting it all in English as well.
Private Sub UserForm_Initialize()
' Preparing all controls of UserForm
Sheet2.Activate
Me.LB_parameter.SetFocus
Me.LB_parameter.value = ""
Me.LB_elements.RowSource = ""
Me.L_element.Enabled = False
Me.TB_element.Enabled = False
Me.TB_element.Locked = True
Me.Btn_Add.Enabled = False
Me.Btn_Add.Locked = True
End Sub
Private Sub LB_parameter_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' Filling the existing list of values for the selected parametr
If Me.LB_parameter.value <> "" Then
Me.LB_elements.RowSource = "D_" & Me.LB_parameter.value & "s"
Me.L_element.Enabled = True
Me.TB_element.Enabled = True
Me.TB_element.Locked = False
Me.TB_element.SetFocus
End If
End Sub
Private Sub TB_element_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' Catching the event of filling out the potential new value
Me.Btn_Add.Enabled = True
Me.Btn_Add.Locked = False
Me.L_element.Enabled = False
Me.TB_element.Enabled = False
Me.TB_element.Locked = True
End Sub
Private Sub Btn_Add_Click()
If Me.TB_element.Text = "" Then
' Check if Empty
MsgBox ("Âû íå âïèñàëè çíà÷åíèå!")
' Reset the UserForm
Me.Btn_Add.Enabled = False
Me.Btn_Add.Locked = True
Me.L_element.Enabled = True
Me.TB_element.Enabled = True
Me.TB_element.Locked = False
Me.TB_element.SetFocus
Else
' check if exists
Dim str
For Each str In range("D_" & Me.LB_parameter.value & "s")
If Me.TB_element.Text = str Then
MsgBox ("Ââåäåííîå çíà÷åíèå óæå ñóùåñòâóåò!")
' reset the UserForm
Me.Btn_Add.Enabled = False
Me.Btn_Add.Locked = True
Me.L_element.Enabled = True
Me.TB_element.Enabled = True
Me.TB_element.Locked = False
Me.TB_element.SetFocus
Me.TB_element.value = ""
Exit Sub
End If
Next str
' add to the range here
Dim x As Integer, y As Integer, v As String
y = range("D_" & Me.LB_parameter.value & "s").Rows.Count + 2
x = Me.LB_parameter.ListIndex + 1
v = Me.TB_element.value
' Next line causes break down
Cells(y, x) = v
MsgBox ("Âû äîáàâèëè ýëåìåíò:'" & v & "' äëÿ ïàðàìåòðà '" & Me.LB_parameter.value & "'.")
' Reset the Userform
Me.LB_parameter.SetFocus
Me.LB_parameter.value = ""
Me.LB_elements.RowSource = ""
Me.L_element.Enabled = False
Me.TB_element.Enabled = False
Me.TB_element.Locked = True
Me.Btn_Add.Enabled = False
Me.Btn_Add.Locked = True
End If
End Sub
Sheet I add values to the parametrs and namedranges window:
The UserForm layout:
Cells(y, x) = v
This call is shorthand for this:
ActiveSheet.Cells(y, x).Value = v
I'm not sure why it's crashing on you, but the _Default property of a Range object being its Value, what I'd try here is being more explicit about what I'm trying to achieve, namely:
Exactly which Worksheet is supposed to get modified?
Exactly which Range is being referred to?
I very very very seldom work with ActiveSheet - most of the time I know exactly what object I'm working with. Try using an object. You can create a new one:
Dim target As Worksheet
Set target = ThisWorkbook.Worksheets("pl")
...Or you can give the sheet a code name in the properties toolwindow (F4):
That (Name) property defines an identifier that you can use in VBA code to access a global-scope object that represents that specific worksheet. Assuming that's Sheet1, you could do this:
Sheet1.Cells(x, y) = v
If that still fails, then you can be even more specific about the Range object you're accessing and the property you're setting:
Dim target As Range
Set target = Sheet1.Cells(x, y)
target.Value = v
Normally that wouldn't make a difference though. But I see you're making Range calls, which are also implicitly calling into the ActiveSheet.
I'd start by eliminating these, and working off an explicit object reference.
Then I'd work on getting the spreadsheet logic out of the form; that button click handler is doing way too many things - but I digress into Code Review territory - feel free to post your code there when you get it to work as intended!
Looks like the problem lies in my version of Excel. Not sure if the problem is in my copy or in the 2013 in general. In Excel 2007 on the same machine the UserForm with given suggestions worked continuously without any errors at all! Will update in comments later as I try it in different versions.
Well I'm also new in VBA programming. I'm creating a form which helps me to do quotations, and then there is a part of my form that shows items I've already registered, like this:
My Form with ComboBoxes
So the purpose of those ComboBoxes is to change or delete the correponding item according with the option I choose, and I would have a lot of them in my UserForm, making it hard to create many ComboBox event programs (like ComboBox1_Change, ComboBox2_Change, ... ComboBox50_Change). And then, the main question is: how could I do it in VBA without loosing a lot of time making the same code for different objects? I would like to create just one code for all ComboBoxes.
I understand that I can do in this way below, but I'm sure that it has a better way to do.
Sub ComboBox1_Change()
Call myCode
End Sub
Sub ComboBox2_Change()
Call myCode
End Sub
Sub ComboBox50_Change()
Call MyCode
End Sub
Sub myCode()
For i=1 to 50
If Controls("ComboBox" & i).Value = "Change" Then
Call MySecondCode
End If
Next i
End Sub
I spent about 30 minutes searching about this question, but I didn't find anything good for me. I hope you guys understood my question. Thanks in advance.
Update:
Axel Richter, as I said in comments, I'm having problem in this:
Private Function isNOKTest()
If prod1.Value = "" Or _
prod2.Value = "" Or _
tecido.Value = "" Or _
tamanhos.Value = "" Or _
unitario.Value = "" Or _
quantidade.Value = "" Then
isNOKTest = True
End If
End Function
Private myCBsWithEvents As Collection
Private Sub UserForm_Initialize()
Set myCBsWithEvents = New Collection
For Each c In Me.Controls
If Left(c.Name, 8) = "ComboBox" Then
c.AddItem "CHANGE"
c.AddItem "DELETE"
Set myCBWithEvents = New clsCBWithEvents
Set myCBWithEvents.myCB = c
myCBsWithEvents.Add myCBWithEvents
End If
Next
End Sub
'
'
'
'datatext.Value = Format(Now, "dd/mm/yyyy")
'bordadoqty.Value = 1
'estampaqty.Value = 1
'Itemlab.Caption = 1
'
When any code is added to the project, the event in class module doesn't work, apparently isn't linked with "Events", but I don't know what happened.
This can be achieved using a class module which handles the events.
Insert a class module in your project. Name it clsCBWithEvents. In this class module have the following code:
Public WithEvents myCB As ComboBox
Private Sub myCB_Change()
If Me.myCB.Value = "Change" Then
MsgBox Me.myCB.Name & " has changed to ""Change"""
ElseIf Me.myCB.Value = "Delete" Then
MsgBox Me.myCB.Name & " has changed to ""Delete"""
End If
End Sub
In your user form have the following code:
Private myCBsWithEvents As Collection
Private Sub UserForm_Initialize()
Set myCBsWithEvents = New Collection
For Each c In Me.Controls
If TypeName(c) = "ComboBox" Then
c.AddItem "Change"
c.AddItem "Delete"
Set myCBWithEvents = New clsCBWithEvents
Set myCBWithEvents.myCB = c
myCBsWithEvents.Add myCBWithEvents
End If
Next
End Sub
Now every ComboBox in this user form will use this event handling.
I'm trying to avoid Event loops by disabling Events at crucial points. However, it doesn't always work. For instance, this code for a Combo box:
Private Sub TempComboS_Change()
Dim e
e = Application.EnableEvents
Application.EnableEvents = False
'
Application.EnableEvents = e
End Sub
The blank line is where the useful code goes; as it stands it obviously doesn't do anything. However, when I run it this way (with the blank line), it reaches "End Sub", then it goes back to the beginning and runs again. (This would make the useful code run twice).
Why is this happening?
EDIT: To clarify for the folks who've been helping me.
I have a macro that opens the dropdown list of the Combo box, activates it, then ends. It works properly. When I select an item from the open list, the Change event runs. This is the current version of the change event:
Private Sub TempComboS_Change()
End Sub
I put a breakpoint on the Private Sub line. It shows that this Change event runs, then runs again. I suspect that it has been doing this all along, and I noticed it now because I need to add code here.
I have no class modules or userforms. The controls are on a worksheet.
I'm going to try the "Run Once" suggestion, and I'll let you know if it works.
I tried the "Run Once" code you suggested. It sort of works, but I seem to have a bigger issue. When I select a drop-down list from a data-validated cell, the TempComboS_Change event triggers -- but not only didn't I touch this combo box, the cell isn't the LinkedCell for the combo box. In other words, it seems to be triggering by actions unconnected to the combo box!
Got to find out about that Call Stack thing...
Here is a bit of code to help investigate "sequence of events" issues
In a Standard Module
Public Enum eNewLine
No
Before
After
Both
End Enum
Public Function timeStamp(Optional d As Double = 0, Optional newLine As eNewLine = No, Optional Indent As Long = 0, _
Optional Caller As String, Optional Context As String, Optional message As String) As String
Dim errorMessage As String
If Err.number <> 0 Then
errorMessage = "ERROR: " & Err.number & ": " & Err.Description
Err.Clear
End If
If d = 0 Then d = Time
With Application.WorksheetFunction
timeStamp = .Text(Hour(d), "00") & ":" & .Text(Minute(d), "00") & ":" & .Text(Second(d), "00") & ":" & .rept(Chr(9), Indent)
End With
If Len(Caller) <> 0 Then timeStamp = timeStamp & Chr(9) & Caller
If Len(Context) <> 0 Then timeStamp = timeStamp & ": " & Chr(9) & Context
If Len(message) <> 0 Then timeStamp = timeStamp & ": " & Chr(9) & message
Select Case newLine
Case Before
timeStamp = Chr(10) & timeStamp
Case After
timeStamp = timeStamp & Chr(10)
Case Both
timeStamp = Chr(10) & timeStamp & Chr(10)
Case Else
End Select
If Len(errorMessage) <> 0 Then
timeStamp = timeStamp & Chr(9) & errorMessage
End If
End Function
At the top of each Module
'Module level Trace Hearder
Const debugEvents as Boolean = True
Const cModuleName As String = "myModuleName"
Const cModuleIndent As Long = 1
You can assign a module level indent for each module to organise the hierarchy an make it easy to understand.
In each Sub or Function (or property if you need)...
sub mySubName()
Const cMyName As String = "mySubName"
If debugEvents Then Debug.Print timeStamp(NewLine:=Before,Indent:=cModuleIndent, Caller:=cModuleName, Context:=cMyName, Message:="Start")
'Do stuff
If debugEvents Then Debug.Print timeStamp(NewLine:=After,Indent:=cModuleIndent, Caller:=cModuleName, Context:=cMyName, Message:="End")
End Sub
...Or you can use Me.Name for the Context if its a form or a sheet etc. and you can put whatever message or variable values you like in the Message.
You can also use a Timer (eg MicroTimer) and put the result in the Message section.
Here is an example output:
15:54:07: Roll-Up Select: Worksheet_Activate: Start: 3.24591834214516E-03
15:54:07: cDataViewSheet: Class_Initialize: Start
15:54:07: cRevealTarget: Class_Initialize: START
15:54:07: cRevealTarget: Class_Initialize: END
15:54:09: cDataViewSheet: startTimer: : START
15:54:09: cDataViewSheet: startTimer: init Timer
15:54:09: cOnTime: Class_Initialize
15:54:09: cOnTime: Let PulseTime: Inheret PulseTime from host sheet
15:54:09: cDataViewSheet: startTimer: : END
15:54:09: Roll-Up Select: Worksheet_Activate: END: 1.38736216780671
Private Sub cmbOrder_Change()
If cmbOrder = "" Then Exit Sub
Dim arr As Variant, maxorder As Integer
arr = Range("rngOrder")
maxorder = WorksheetFunction.Max(arr)
Dim errmsg As String, err As Boolean
err = False
errmsg = "This value must be a whole number between 1 and " & maxorder + 1
Dim v As Variant
v = cmbOrder.Value
If IsNumeric(v) = False Or (IsNumeric(v) = True And (v > maxorder + 1) Or v < 1)
Then
MsgBox errmsg
cmbOrder = ""
err = False
Else
txtOrder.Value = cmbOrder.Value
End If
End Sub
A bit late to the party but the problem of code repetition can be shown here in similar circumstances. Remove the first line of code and any error messages are dished out twice. This is because of the line that clears the ComboBox that is regarded as a change and picks up another error as null input is an error! May help someone with similar issue.
The Combobox_Change() will fire whenever there is a change in the combobox. For example
Option Explicit
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Bah Blah"
End Sub
Private Sub CommandButton1_Click()
'~~> If something is selected in the combo then
'~~> this line will cause ComboBox1_Change to fire
ComboBox1.Clear
End Sub
Private Sub ComboBox1_Change()
MsgBox "A"
End Sub
So if you load the userform and select an item ComboBox1_Change will fire. You then use the commanbutton to clear the combo the ComboBox1_Change will again fire.
There is one more scenario when the change will again fire. When you change the combobox from the ComboBox1_Change event itself. Here is an example. And I believe this is what is happening in your case.
Scenario 1
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Bah Blah"
End Sub
Private Sub ComboBox1_Change()
MsgBox "A"
ComboBox1.Clear
End Sub
Scenario 2
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Bah Blah"
ComboBox1.AddItem "Bah Blah Blah"
End Sub
Private Sub ComboBox1_Change()
MsgBox "A"
ComboBox1.ListIndex = 1
End Sub
In the first scenario you can getaway with
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Bah Blah"
End Sub
Private Sub ComboBox1_Change()
If ComboBox1 <> "" Then
MsgBox "A"
End If
End Sub
In the 2nd Scenario, you can use something like this
Dim boolRunOnce As Boolean
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Bah Blah"
ComboBox1.AddItem "Bah Blah Blah"
End Sub
Private Sub ComboBox1_Change()
If boolRunOnce = False Then
MsgBox "A"
boolRunOnce = True
ComboBox1.ListIndex = 1
Else
boolRunOnce = False
End If
End Sub