Why do I get run-time error -2147417848 (80010108) in excel 2013 most of the time I run UserForm? - excel

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.

Related

Simplify VBA code with repetitive operations

I created a userform with a large number of textboxes and tick boxes. When the userform is initialised, data is loaded into the textboxes and the tick box values are defined by values specified in one of the workbook tabs.
I have written code with lots of repetition. For example, I include the code below for every textbox that is populated by a number.
Controls("ll_f_m_prior").Value = Format(Range("ll_f_m_prior_p"), "standard")
If Controls("ll_f_m_prior").Value = "n/a" Or Controls("ll_f_m_prior").Value = "" Then
Controls("ll_f_m_prior").Enabled = False
cb1.Enabled = False
End If
I have 25+ textboxes where the code is repeated. I am looking for a way to call a function using two dynamic variables. In the above example, the two variables are ll_f_m_prior and cb1.
I tried this code
Sub error1(var1 As String, var2 As String)
Controls(var1).Value = Format(Range(var1), "standard")
If Controls(var1).Value = "n/a" Or Controls(var1).Value = "" Then
Controls(var1).Enabled = False
x = var2 & ".Enabled"
x = False
End If
End Sub
and calling the subroutine using the function:
Call error1("ll_f_m_prior_p", cb1)
When you call the sub with Call error1("ll_f_m_prior_p", cb1) cb1isn't a string.
Yet the sub expects a string.
So if you change the second variable to act as an object instead, that should make things easier.
Sub error1(var1 As String, var2 As Object)
Controls(var1).Value = Format(Range(var1), "standard")
If Controls(var1).Value = "n/a" Or Controls(var1).Value = "" Then
Controls(var1).Enabled = False
var2.Enabled = False
End If
End Sub

Looping along named ranges in VBA with a hidden =true/false output for the range itself, not the data within the range

I have named a number of columns as ranges e.g.
DesCond1, DesDiff1, Comparison1, DesCond2, DesDiff2, Etc...
I have some buttons which use a macro to toggle the different columns visible or hidden. I have added the code I am using for one of these buttons.
Currently I have written the code to show or hide each range individually but I would like a code that will count the number of ranges with a similar name (DesCond1, DesCond2.. DesCond(n))and then loop through each one automatically checking the hidden status so I don't have to add to the code everytime I add more data. Here is my code so far. This works fine so far.
Sub ComparisonToggle1()
Dim ComparisonAll As Range, R_Cond As Range, R_Diff As Range
'set first of each range as identifier for decisions
Set R_Comp = Range("Comparison1")
'set all ranges under one name
Set CompAll = Union(Range("Comparison1"), Range("Comparison2"), Range("Comparison3")) 'name and add when new tests are added
If R_Comp.EntireColumn.Hidden = False Then 'False
CompAll.EntireColumn.Hidden = True 'hide all
ElseIf R_Comp.EntireColumn.Hidden = True Then 'True
CompAll.EntireColumn.Hidden = False 'vis all
End If
End Sub
Sub DesignToggle1()
Dim DesCondAll As Range, DesDiffAll As Range, R_Cond As Range, R_Diff As Range
'set first of each range as identifier for decisions
Set R_Cond = Range("DesCond1")
Set R_Diff = Range("DesDiff1")
'set all ranges under one name
Set DesCondAll = Union(Range("DesCond1"), Range("DesCond2"), Range("DesCond3"), Range("DesCond4"), Range("DesCond5"), Range("DesCond6")) 'name and add when new tests are added
Set DesDiffAll = Union(Range("DesDiff1"), Range("DesDiff2"), Range("DesDiff3"), Range("DesDiff4"), Range("DesDiff5"), Range("DesDiff6")) 'name and add when new tests are added
If R_Cond.EntireColumn.Hidden = False And R_Diff.EntireColumn.Hidden = False Then 'False/False
DesCondAll.EntireColumn.Hidden = True 'both hidden
DesDiffAll.EntireColumn.Hidden = True
ElseIf R_Cond.EntireColumn.Hidden = True And R_Diff.EntireColumn.Hidden = False Then 'True/False
DesCondAll.EntireColumn.Hidden = False 'vis both
DesDiffAll.EntireColumn.Hidden = False
ElseIf R_Cond.EntireColumn.Hidden = False And R_Diff.EntireColumn.Hidden = True Then 'False/True
DesCondAll.EntireColumn.Hidden = False 'vis both
DesDiffAll.EntireColumn.Hidden = False
ElseIf R_Cond.EntireColumn.Hidden = True And R_Diff.EntireColumn.Hidden = True Then 'True/True
DesCondAll.EntireColumn.Hidden = False 'vis both
DesDiffAll.EntireColumn.Hidden = False
End If
End Sub
This is to loop through all the names in your workbook, thought you need to give it the group you want to filter:
Option Explicit
Sub Test(Group As String)
Dim MyName As Name
For Each MyName In ThisWorkbook.Names
If MyName.Name Like "*" & Group & "*" Then
Range(MyName).EntireColumn.Hidden = True
End If
Next MyName
End Sub
Sub Main()
'This procedure calls the Test procedure feeding the variable Group as "Descond"
Test "Descond"
End Sub

Loop Through CheckBox Controls in VBA UserForm

I have a user form in Excel VBA with a check box for each month.
Selecting one or more cause the required month to be shown on the sheet, I copy-pasted the code 12 times and it works but I'm sure there is a better way doing it with a For loop.
This is a part of my code (it goes on 12 times):
If CheckBox1.Value = True Then
ActiveSheet.PivotTables("PivotTable1").PivotFields("month").PivotItems("1").Visible = True
Else
ActiveSheet.PivotTables("PivotTable1").PivotFields("month").PivotItems("1").Visible = False
End If
If CheckBox2.Value = True Then
ActiveSheet.PivotTables("PivotTable1").PivotFields("month").PivotItems("2").Visible = True
Else
ActiveSheet.PivotTables("PivotTable1").PivotFields("month").PivotItems("2").Visible = False
End If
I tried writing:
for i in range 1 to 12
and then writing my code but there seem to be a problem when I put "i" instead of the numbers.
Assuming you aren't using Tristate checkboxes, then the .Value can only be True or False, so we should be able to get away with something like this:
(Assumes your code runs inside the UserForm, so that Controls is directly accessible)
Dim mthIdx as Long
Dim nm as String
Dim c As Control
With ActiveSheet.PivotTables("PivotTable1").PivotFields("month")
For mthIdx = 1 To 12
nm = "CheckBox" & mthIdx
Set c = Controls(nm)
.PivotItems(mthIdx).Visible = c.Value
Next
End With
(The With clause isn't strictly necessary, but it's usually a good idea to resolve nested COM references as infrequently as possible)
Try this ..
Dim i As Integer
Dim sN As String
Dim chx As MSForms.CheckBox
Dim obj As OLEObject
For i = 1 to 12
sN = format(i)
Set obj = OLEObjects("CheckBox" & sN)
Set chx = obj.Object
If chx.Value = True Then
ActiveSheet.PivotTables("PivotTable" & sN).PivotFields("month").PivotItems(sN).Visible = True
Else
ActiveSheet.PivotTables("PivotTable" & sN).PivotFields("month").PivotItems(sN).Visible = False
End If
Next
I've not checked the code but this should put you along thr right path if it's not spot on though...
For i = 1 to 12
If CheckBox(i).Value = True Then
ActiveSheet.PivotTables("PivotTable1").PivotFields("month").PivotItems(i).Visible = True
Else
ActiveSheet.PivotTables("PivotTable1").PivotFields("month").PivotItems(i).Visible = False
End If
Next i

When reading down a column of Excel file, how to define cell coordinates without selecting a cell?

Can anyone tell me how to improve this macro?
All the macro does is it just reads an Excel file for a list a accounts to update in an application (SmarTerm Beta). It technically already accomplishes the goal, but is there a way to code it so that while it’s reading the Excel file, the coordinates of the cells from which to read the account numbers and also the coordinates of the cells in which to write an output don’t depend on a "pre-selected" a cell? The risk with selecting a cell is that if someone were to accidentally select a different cell while the macro is running, everything will get screwed up.
Here's my current code:
Public oExcelObj As Object
Function WaitSystem(Optional NoDialog as Variant) As Boolean
Dim nContinue as Integer
Dim nTimeOut as Integer 'In seconds.
'The default timeout for each command is 3 minutes.
'Increase this value if your host requires more time
'for each command.
nTimeOut = 10
If IsMissing(NoDialog) then NoDialog = False
'Wait for response from host.
Session.EventWait.Timeout = nTimeOut
Session.EventWait.EventType = smlPAGERECEIVED
Session.EventWait.MaxEventCount = 1
WaitSystem = True
If Session.EventWait.Start = smlWAITTIMEOUT Then
If NoDialog Then
WaitSystem = False
Else
nContinue = QuerySyncError()
If nContinue <> ebYes then WaitSystem = False
End If
End If
Set LockStep = Nothing
End Function
'Establish link. Search for Excel.
Function OleLinkConnection
Const XlMaximized = &HFFFFEFD7
Titlebar$ = AppFind$("Microsoft Excel")
If Titlebar$ <> "" Then
bIsExcelActive = True
If AppGetState(Titlebar$) = ebMinimized Then
AppSetState 2, Titlebar$
End If
Else
bIsExcelActive = False
End If
If bIsExcelActive Then
'Create Excel Object using current instance of Excel.
Set oExcelObj = GetObject(, "Excel.Application")
Else
'Create Excel Object using a new instance of Excel.
Set oExcelObj = CreateObject("Excel.Application")
End If
Version = oExcelObj.Application.Version
oExcelObj.ScreenUpdating = True
oExcelObj.Displayalerts = True
oExcelObj.Visible = true
End Function
Sub JPBmacro
Dim AccountNumber As String
Dim Temp As Integer
Begin Dialog StartDialogTemplate ,,211,74,"Run JPBmacro?"
OKButton 60,12,92,20,.Proceed
CancelButton 60,40,92,20,.Exit
End Dialog
Dim StartDialog As StartDialogTemplate
r% = Dialog(StartDialog)
If r% = 0 Then End
g$ = "G:\DATA\outputfile.xlsx"
oleCode = OleLinkConnection
oExcelObj.Workbooks.Open g$
oExcelObj.Range("A1").Select ‘<----This selects the cell from which all coordinates are based off of. The coordinates of oExcelObj.ActiveCell.Offset(Y,X).Value VBA depend on selecting a cell.
NEXTACCOUNT:
Temp = 0
AccountNumber = oExcelObj.ActiveCell.Offset(Temp,0).Value
While AccountNumber <> ""
Session.SendKey "CLEAR"
If WaitSystem = False Then End
Session.Send "ACTU " & AccountNumber
Session.SendKey "ENTER"
If WaitSystem = False Then End
If Trim(Session.ScreenText(4,6,1,22)) = "INVALID ACCOUNT NUMBER" Or Trim(Session.ScreenText(4,6,1,19)) = "ACCOUNT NOT ON FILE" Then
oExcelObj.ActiveCell.Offset(Temp,1).Value = Trim(Session.ScreenText(4,6,1,22))
GoTo RESTARTLOOP
End If
UPDATEIOV:
If Trim(Session.ScreenText(13,76,1,1)) = "Y" Then
oExcelObj.ActiveCell.Offset(Temp,1).Value = "Account already flagged as institutional."
Else
Session.Row = 13
Session.Column = 76
Session.send "Y"
Session.SendKey "ENTER"
If WaitSystem = False Then End
oExcelObj.ActiveCell.Offset(Temp,1).Value = Trim(Session.ScreenText(24,2,1,50))
End If
RESTARTLOOP:
Temp = Temp + 1
AccountNumber = oExcelObj.ActiveCell.Offset(Temp,0).Value
Wend
ENDNOW:
oExcelObj.Workbooks.Close
MsgBox "All Done!"
End Sub
Why not keep the reference to the first cell?
Dim rng as Range
Set rng = oExcelObj.Range("A1")
i=1
...
x = rng.Cell(i,1).Value
'Or faster yet is reading all the values into an variant array.
Dim array() as Variant
array = rng.Resize(N,M).Value
' Work with array as
x = array(i,1)
Given the comment from assylias and that another poster has since "answered" with this approach:
I can't see where oExcelObj is instantiated? Or how you are referring to a specific sheet.
Regardless of which,
you can avoid select by setting a range, ie Set rng1 = oExcelObj.Sheets(1).Range("A1")
and then use offsets from rng1.
The user won't be able to interfere while the code is running

Excel Diagramm Seriesnames in VBA

I'm programming a Makro for a Excel xy-Diagramm
The diagramm is nearly correct, but i have dublicate DataSeriesNames;
I already tried to go through all Series and Compare the Names.
There were no Errors, but it didn't work.
Code was like that:
For a=1 to Count
If ActiveChart.SeriesCollection(Count).Name = Range("A2").Value Then
Name = true
End If
a = a + 1
Next
If Name = false Then
ActiveChart.SeriesCollection.NewSeries
End If
ActiveChart.SeriesCollection(Count).Name = "='Tasks'!$D$" & i
ActiveChart.SeriesCollection(Count).XValues = "='Tasks'!$B$" & i
ActiveChart.SeriesCollection(Count).Values = "='Tasks'!$C$" & i
Mfg Robin
There are a couple of things wrong here.
First of all, you're always looking at the same series! I think you want to replace Count with a in your If statement.
If ActiveChart.SeriesCollection(a).Name
Secondly, once that is corrected, even if your Name variable gets set to True at some point, it may get reset to False later as the For...Next loop continues iterating through the remainder of the series collection. To prevent this, add an Exit For like this:
For a = 1 To Count
If ActiveChart.SeriesCollection(a).Name = Range("A2").Value Then
Name = True
Exit For
End If
a = a + 1
Next
Also, I suspect you haven't declaring Name as a Boolean variable, so by default it's a Variant so its value isn't False to start with! You should declare the variable at the top of your procedure with Dim Name as Boolean, and then if you want Name to be False by default, you should really say so explicitly: Put Name = False before the loop. Moreover, Name is a terrible name for a variable... and so is Count Argh! I think your code should look like this:
Option Explicit
Sub MySub()
Dim a As Long
Dim NameExists As Boolean
Dim SeriesCount As Long
SeriesCount = ActiveChart.SeriesCollection.Count
NameExists = False
For a = 1 To SeriesCount
If ActiveChart.SeriesCollection(a).Name = Range("A2").Value Then
NameExists = True
Exit For
End If
a = a + 1
Next
If NameExists = False Then
' Rest of your code goes here...
End Sub

Resources