Basically, I have an Excel Formatted Table called "TestTable" in my activesheet. That's the only table in that sheet. I'm trying to convert it to a normal range. From looking up online, this should be simple, all I have to do is Unlist that table object.
However, my VBA code is throwing an error. Any pointers in the right direction would be greatly appreciated.
Sub ConverToNormalRange()
Dim objListObj As ListObject
Set objListObj = ActiveSheet.ListObjects(1)
objListObj.Unlist
End Sub
When I run the above macro, I get the following error:
Convert First Table to a Range
Sub ConvertToRange()
Const ProcName As String = "ConvertToRange"
On Error GoTo ClearError
With ActiveSheet ' improve!
If .ListObjects.Count > 0 Then
Dim tblName As String
With .ListObjects(1)
tblName = .Name
.Unlist
End With
MsgBox "Table '" & tblName & "' converted to a range.", _
vbInformation
Else
MsgBox "No table found in worksheet '" & .Name & "'.", _
vbExclamation
End If
End With
ProcExit:
Exit Sub
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Sub
I tried converting the table manually and it wasn't doing anything either. So then I figured it wasn't a VBA problem. It turns out that I had connections open in Power Query, and it was preventing the table from converting back to normal range.
I want to create a pie chart with linked sheet but when I am clicking on the graph I am getting some error, "Compile error Argument not optional" on the "WorkSheetFunction.Index" line of the code.
I am beginner in VBA coding.. Please help
this is my code
xl page
ThisWorkbook module
Dim ChartObjectClass As New Class1
Dim ChartObjectClass2 As New Class2
Private Sub Workbook_Open()
Set ChartObjectClass.ChartObject = Worksheets(1).ChartObjects(1).Chart
Set ChartObjectClass2.ChartObject = Worksheets(1).ChartObjects(2).Chart
End Sub
Class module
Option Explicit
Public WithEvents ChartObject As Chart
Private Sub ChartObject_MouseUp(ByVal Button As Long, ByVal Shift As Long, _
ByVal x As Long, ByVal y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim myX As Variant, myY As Double
With ActiveChart
.GetChartElement x, y, ElementID, Arg1, Arg2
If ElementID = xlSeries Or ElementID = xlDataLabel Then
If Arg2 > 0 Then
myX=WorksheetFunction.Index(.SeriesCollection(Arg1).XValues.Arg2)
myY=WorksheetFunction.Index(.SeriesCollection(Arg1).Values.Arg2)
MsgBox "Series" & Arg1 & vbCrLf & """" & .SeriesCollection(Arg1)_
.Name & """" & vbCrLf & "Point" & Arg2 & vbCrLf & _
"x= " & myX & vbCrLf & "y= " & myY
Range("A1").Select
On Error Resume Next
Sheets("Series" & myX & "Detail").Select
Range("A1").Select
On Error GoTo 0
End If
End If
End With
End Sub
In your case, Index requires two arguments. The first argument specifies the array of values from which to return a value. The second argument specifies the nth element from the array to return.
myX = WorksheetFunction.Index(.SeriesCollection(Arg1).XValues, Arg2)
myY = WorksheetFunction.Index(.SeriesCollection(Arg1).Values, Arg2)
By the way, you can also dispense with the use of WorksheetFunction.Index...
myX = .SeriesCollection(Arg1).XValues()(Arg2)
myY = .SeriesCollection(Arg1).Values()(Arg2)
I'm trying to write a code module using the InsertLines method, but am getting the
Statement too complex Error
My code boils down to this loop:
Dim extractorModule As VBComponent
With extractorModule.codeModule
Dim singItem As codeItem
Dim i As Long
For i = LBound(codeItems) To UBound(codeItems)
singItem = codeItems(i) 'array of private type with .value property
.InsertLines 5, singItem.value 'write to line 5
Next i
End With
Which loops through an array of custom codeItems, and writes their .value to a new module with .InsertLines
singItem.value is a base64 encoded string. If it is a short one, 100 characters say, like this string:
.code_content = "QXR0cmlidXRlIFZCX05hbWUgPSAic2ltcGxlTW9kdWxlIg0KUHJpdmF0ZSBhIEFzIExvbmcNCg=="
no problem. However I want a longer string, this one for example (19000 chars, contains newlines):
.code_content = "QXR0cmlidXRlIFZCX05hbWUgPSAicHJvamVjdENvbXByZXNzb3IiDQonQ29tcHJlc3NvciBtb2R1bGUsIGNvbXByZXNzZXMgYSBsb2FkIG9mIGZpbGVzIGludG8gc3RyaW5ncyB0byBleHBvcnQNCk9wdGlvbiBFeHBsaWNpdA0KUHJpdmF0ZSBUeXBlIGNvZGVJdGVtDQogICAgZXh0ZW5zaW9uIEFzIFN0cmluZw0KICAgIG1vZHVsZV9uYW1lIEFzIFN0cmluZw0KICAgIGNvZGVfY29udGVudCBBcyBTdHJpbmcNCkVuZCBUeXBlDQpQcml2YXRlIENvbnN0IFR5cGVCaW5hcnkgPSAxDQoNClB1YmxpYyBTdWIgY29tcHJlc3NQcm9qZWN0KFBhcmFtQXJyYXkgZmlsZW5hbWVzKCkpDQogICAgJ1N1YiB0byBjb252ZXJ0IHNlbGVjdGVkIGZpbGVzIGludG8gc2VsZi1leHRyYWN0aW5nIG1vZHVsZQ0KICAgICdJbnB1dDoNCiAgICAnICAgZmlsZW5hbWVzOiBhcnJheSBvZiBzdHJpbmdzIGJhc2VkIG9uIG5hbWVzIG9mIG1vZHVsZXMgaW4gcHJvamVjdA0KICAgIElmIE5vdCBwcm9qZWN0X2FjY2Vzc2libGUgVGhlbg0KICAgICAgICBNc2dCb3ggIkFjY2VzcyB0byBWQkEgcHJvamVjdCBpcyByZXN0cmljdGVkLCB0aGlzIHdvbid0IHdvcmshIg0KICAgICAgICBFeGl0IFN1Yg0KICAgIEVuZCBJZg0KDQogICAgRGltIGNvZGVJdGVtcygpIEFzIGNvZGVJdGVtDQogICAgRGltIGFycmF5U3QgQXMgTG9uZywg" & _
"YXJyYXlFbmQgQXMgTG9uZywgaSBBcyBMb25nDQogICAgYXJyYXlTdCA9IExCb3VuZChmaWxlbmFtZXMpDQogICAgYXJyYXlFbmQgPSBVQm91bmQoZmlsZW5hbWVzKQ0KICAgIFJlRGltIGNvZGVJdGVtcyhhcnJheVN0IFRvIGFycmF5RW5kKQ0KICAgIA0KICAgIERlYnVnLlByaW50ICJHZXR0aW5nIERlZmluaXRpb25zLi4uIg0KICAgIFdpdGggVGhpc1dvcmtib29rLlZCUHJvamVjdC5WQkNvbXBvbmVudHMNCiAgICAgICAgJ2xvb3AgdGhyb3VnaCBmaWxlcyBjb21wcmVzc2luZyB0aGVtIGludCA2NCBiaXQgc3RyaW5ncw0KICAgICAgICBGb3IgaSA9IGFycmF5U3QgVG8gYXJyYXlFbmQNCiAgICAgICAgICAgIGNvZGVJdGVtcyhpKSA9IG1vZHVsZURlZmluaXRpb24oZmlsZW5hbWVzKGkpKQ0KICAgICAgICBOZXh0IGkNCiAgICBFbmQgV2l0aA0KICAgIERlYnVnLlByaW50ICwgIkRlZmluaXRpb25zIHNhdmVkIg0KICAgICd3cml0ZSBzdHJpbmdzIHRvIHNrZWxldG9uIGZpbGUNCiAgICAgICAgRGVidWcuUHJpbnQgIldyaXRpbmcgZmlsZS4uLiINCiAgICB3cml0ZVNrZWxldG9uIGNvZGVJdGVtcw0KRGVidWcuUHJpbnQgIkNvbXBsZXRlIg0KRW5kIFN1Yg0KUHJpdmF0ZSBTdWIgd3JpdGVTa2VsZXRvbihjb2RlSXRlbXMoKSBBcyBjb2RlSXRlbSwgT3B0aW9uYWwgd2IgQXMgVmFyaWFudCwg" & _
"T3B0aW9uYWwgQnlSZWYgcHJvamVjdE5hbWUgQXMgU3RyaW5nID0gIm15UHJvamVjdCIpICcgLCBPcHRpb25hbCB3YiBBcyBWYXJpYW50KQ0KICAgIERpbSBpdGVtQ291bnQgQXMgTG9uZw0KICAgIGl0ZW1Db3VudCA9IFVCb3VuZChjb2RlSXRlbXMpIC0gTEJvdW5kKGNvZGVJdGVtcykgKyAxDQogICAgSWYgaXRlbUNvdW50IDwgMSBUaGVuIEV4aXQgU3ViDQogICAgDQogICAgRGltIGJvb2sgQXMgV29ya2Jvb2sNCiAgICBJZiBJc01pc3Npbmcod2IpIFRoZW4gU2V0IGJvb2sgPSBUaGlzV29ya2Jvb2sgRWxzZSBTZXQgYm9vayA9IHdiDQogICAgJ2NyZWF0ZSBzZWxmLWV4dHJhY3RpbmcgbW9kdWxlIGFuZCBzZXQgbmFtZQ0KDQogICAgRGltIGV4dHJhY3Rvck1vZHVsZSBBcyBWQkNvbXBvbmVudA0KICAgIFNldCBleHRyYWN0b3JNb2R1bGUgPSBib29rLlZCUHJvamVjdC5WQkNvbXBvbmVudHMuQWRkKHZiZXh0X2N0X1N0ZE1vZHVsZSkNCiAgICBleHRyYWN0b3JNb2R1bGUuTmFtZSA9IHByb2plY3ROYW1lICdtYXkgZXJyIGlmIGR1cGxpY2F0ZSAtIGNoYW5nZXMNCkRlYnVnLlByaW50ICwgIlByb2plY3QgZmlsZSBhZGRlZCINCiAgICAnd3JpdGUgY29kZSB0byBtb2R1bGUNCiAgICBEaW0gY29kZUluc2VydFBvaW50IEFzIExvbmcNCiAgICBjb2RlSW5zZXJ0UG9pbnQgPSBmaWxsTW9kdWxl" & _
"KGV4dHJhY3Rvck1vZHVsZS5jb2RlTW9kdWxlKSgwKSAneCBjb29yZA0KRGVidWcuUHJpbnQgLCAiUHJvamVjdCBza2VsZXRvbiB3cml0dGVuIg0KICAgICdhbW1lbmQgY29kZSB3aXRoIGNvZGVpdGVtcyBhbmQga2lsbGluZyBsaW5lDQogICAgJ1dpdGggZXh0cmFjdG9yTW9kdWxlLmNvZGVNb2R1bGUNCiAgICANCiAgICBEaW0gdiBBcyBjb2RlTW9kdWxlDQogICAgU2V0IHYgPSBleHRyYWN0b3JNb2R1bGUuY29kZU1vZHVsZQ0KICAgIHYuRGVsZXRlTGluZXMgY29kZUluc2VydFBvaW50DQogICAgRGltIHNpbmdJdGVtIEFzIGNvZGVJdGVtDQogICAgRGltIGkgQXMgTG9uZywgbG93ZXJWYWwgQXMgTG9uZywgdXBwZXJWYWwgQXMgTG9uZw0KICAgIGxvd2VyVmFsID0gTEJvdW5kKGNvZGVJdGVtcykNCiAgICB1cHBlclZhbCA9IFVCb3VuZChjb2RlSXRlbXMpDQoNCiAgICAgICAgDQogICAgJ2xvb3AgdGhyb3VnaCBhZGRpbmcgY29kZSBkZWZpbml0aW9ucw0KICAgIEZvciBpID0gbG93ZXJWYWwgVG8gdXBwZXJWYWwNCiAgICAgICAgc2luZ0l0ZW0gPSBjb2RlSXRlbXMoaSkNCiAgICAgICAgRGltIHMgQXMgU3RyaW5nOiBzID0gcHJpbnRmKFN0cmluZyg0LCB2YlRhYikgJiAiLmNvZGVfY29udGVudCA9IHswfSIsIHNpbmdJdGVtLmNvZGVfY29udGVudCkNCiAgICAgICAgRGVidWcuUHJpbnQg" & _
"LCAiRm9ybWF0dGVkIGZpbmUiDQoNCiAgICAgICAgRGVidWcuUHJpbnQgIm1hZGUgaXQgdG8iDQogICAgICAgIERlYnVnLlByaW50IHMNCiAgICAgICAgdi5JbnNlcnRMaW5lcyBjb2RlSW5zZXJ0UG9pbnQsIHMNCiAgICAgICAgRGVidWcuUHJpbnQgIm1hZGUgaXQgcGFzdCINCicgICAgICAgIC5JbnNlcnRMaW5lcyBjb2RlSW5zZXJ0UG9pbnQsIHByaW50ZihTdHJpbmcoNCwgdmJUYWIpICYgIi5tb2R1bGVfbmFtZSA9ICIiezB9IiIiLCBzaW5nSXRlbS5tb2R1bGVfbmFtZSkNCicgICAgICAgIC5JbnNlcnRMaW5lcyBjb2RlSW5zZXJ0UG9pbnQsIHByaW50ZihTdHJpbmcoNCwgdmJUYWIpICYgIi5leHRlbnNpb24gPSAiInswfSIiIiwgc2luZ0l0ZW0uZXh0ZW5zaW9uKQ0KJw0KJyAgICAgICAgLkluc2VydExpbmVzIGNvZGVJbnNlcnRQb2ludCwgcHJpbnRmKFN0cmluZygzLCB2YlRhYikgJiAiQ2FzZSB7MH0iLCBpdGVtQ291bnQpDQogICAgICAgIGl0ZW1Db3VudCA9IGl0ZW1Db3VudCAtIDENCkRlYnVnLlByaW50ICwgIkluc2VydGVkIGNvZGUgY29udGVudCBmb3IgZmlsZTogIjsgaQ0KICAgIE5leHQgaQ0KDQogICAgRGltIGtpbGxMaW5lIEFzIExvbmcgJ3BsYWNlIGZvciBhZGRpbmcgbGFzdCBiaXQgb2YgY29kZSB0byByZW1vdmUgc2VsZi1leHRyYWN0b3INCicgICAgLkZpbmQgInsx" & _
"fSIsIGtpbGxMaW5lLCAxLCAtMSwgLTENCicgICAgLlJlcGxhY2VMaW5lIGtpbGxMaW5lLCBSZXBsYWNlKC5MaW5lcyhraWxsTGluZSwgMSksICJ7MX0iLCBwcm9qZWN0TmFtZSkNCkRlYnVnLlByaW50ICwgIkluc2VydGVkIGtpbGxMaW5lIg0KICAgICdFbmQgV2l0aA0KICAgIA0KRW5kIFN1Yg0KDQoNClByaXZhdGUgRnVuY3Rpb24gbW9kdWxlRGVmaW5pdGlvbihtb2R1bGVOYW1lLCBPcHRpb25hbCB3YiBBcyBWYXJpYW50KSBBcyBjb2RlSXRlbQ0KICAgIERpbSBjb2RlTW9kdWxlIEFzIFZCQ29tcG9uZW50DQogICAgRGltIGJvb2sgQXMgV29ya2Jvb2sNCiAgICBEaW0gcmVzdWx0IEFzIGNvZGVJdGVtDQogICAgSWYgSXNNaXNzaW5nKHdiKSBUaGVuIFNldCBib29rID0gVGhpc1dvcmtib29rIEVsc2UgU2V0IGJvb2sgPSB3Yg0KICAgIFNldCBjb2RlTW9kdWxlID0gYm9vay5WQlByb2plY3QuVkJDb21wb25lbnRzKG1vZHVsZU5hbWUpDQogICAgJ2dldCBleHRlbnNpb24gYW5kIG5hbWUNCiAgICBTZWxlY3QgQ2FzZSBjb2RlTW9kdWxlLlR5cGUNCiAgICBDYXNlIHZiZXh0X2N0X1N0ZE1vZHVsZQ0KICAgICAgICByZXN1bHQuZXh0ZW5zaW9uID0gIi5iYXMiDQogICAgQ2FzZSB2YmV4dF9jdF9DbGFzc01vZHVsZQ0KICAgICAgICByZXN1bHQuZXh0ZW5zaW9uID0gIi5jbHMiDQogICAgQ2Fz" & _
"ZSB2YmV4dF9jdF9NU0Zvcm0NCiAgICAgICAgcmVzdWx0LmV4dGVuc2lvbiA9ICIuZnJtIg0KICAgIENhc2UgRWxzZQ0KICAgICAgICByZXN1bHQuZXh0ZW5zaW9uID0gIm1pc3NpbmciDQogICAgICAgIG1vZHVsZURlZmluaXRpb24gPSByZXN1bHQNCiAgICAgICAgRXhpdCBGdW5jdGlvbg0KICAgIEVuZCBTZWxlY3QNCiAgICANCiAgICByZXN1bHQubW9kdWxlX25hbWUgPSBjb2RlTW9kdWxlLk5hbWUNCiAgICAnc2F2ZSB0byB0ZW1wIHBhdGgNCiAgICBEaW0gdGVtcFBhdGggQXMgU3RyaW5nDQogICAgdGVtcFBhdGggPSBwcmludGYoInswfVx7MX17Mn0iLCBFbnZpcm9uJCgidGVtcCIpLCByZXN1bHQubW9kdWxlX25hbWUsIHJlc3VsdC5leHRlbnNpb24pDQogICAgY29kZU1vZHVsZS5FeHBvcnQgdGVtcFBhdGgNCiAgICBPbiBFcnJvciBHb1RvIHNhZmVFeGl0DQogICAgcmVzdWx0LmNvZGVfY29udGVudCA9IGNodW5raWZ5KFRvQmFzZTY0KHJlYWRCeXRlcyh0ZW1wUGF0aCkpKSAnZW5jb2RlIGFuZCBjaHVua2lmeQ0KICAgIA0Kc2FmZUV4aXQ6DQogICAgS2lsbCB0ZW1wUGF0aA0KICAgIG1vZHVsZURlZmluaXRpb24gPSByZXN1bHQNCiAgICBJZiBFcnIuTnVtYmVyIDw+IDAgVGhlbiBtb2R1bGVEZWZpbml0aW9uLmV4dGVuc2lvbiA9ICJtaXNzaW5nIg0KRW5kIEZ1bmN0aW9uDQoNClBy" & _
"aXZhdGUgRnVuY3Rpb24gcHJpbnRmKG1hc2sgQXMgU3RyaW5nLCBQYXJhbUFycmF5IHRva2VucygpKSBBcyBTdHJpbmcNCiAgICBEZWJ1Zy5QcmludCAsICIgLT4gRm9ybWF0dGluZyI7IExlbih0b2tlbnMoMCkpOyAiY2hhcnMgaW50byIsICIiIiI7IG1hc2s7ICIiIiINCiAgICBEaW0gaSBBcyBMb25nDQpPbiBFcnJvciBHb1RvIGJhZFByaW50DQogICAgRm9yIGkgPSAwIFRvIFVCb3VuZCh0b2tlbnMpDQogICAgICAgIG1hc2sgPSBSZXBsYWNlJChtYXNrLCAieyIgJiBpICYgIn0iLCB0b2tlbnMoaSkpDQogICAgTmV4dA0KICAgIHByaW50ZiA9IG1hc2sNCiAgICAgICAgRXhpdCBGdW5jdGlvbg0KYmFkUHJpbnQ6DQogICAgcHJpbnRmID0gbWFzaw0KICAgIERlYnVnLlByaW50IFN0cmluZygxMCwgIi0iKQ0KICAgIERlYnVnLlByaW50ICJQcmludEYgZXJyb3Igb24iLCB0b2tlbnMoMCkNCiAgICBEZWJ1Zy5QcmludCBTdHJpbmcoMTAsICItIikNCkVuZCBGdW5jdGlvbg0KDQpQcml2YXRlIEZ1bmN0aW9uIHByb2plY3RfYWNjZXNzaWJsZSgpIEFzIEJvb2xlYW4NCiAgICBPbiBFcnJvciBSZXN1bWUgTmV4dA0KICAgIFdpdGggVGhpc1dvcmtib29rLlZCUHJvamVjdA0KICAgICAgICBwcm9qZWN0X2FjY2Vzc2libGUgPSAuUHJvdGVjdGlvbiA9IHZiZXh0X3BwX25vbmUNCiAgICAgICAgcHJv" & _
"amVjdF9hY2Nlc3NpYmxlID0gcHJvamVjdF9hY2Nlc3NpYmxlIEFuZCBFcnIuTnVtYmVyID0gMA0KICAgIEVuZCBXaXRoDQpFbmQgRnVuY3Rpb24NCg0KUHJpdmF0ZSBGdW5jdGlvbiByZWFkQnl0ZXMoZmlsZSBBcyBTdHJpbmcpIEFzIEJ5dGUoKQ0KICBEaW0gaW5TdHJlYW0gQXMgT2JqZWN0DQogICcgQURPREIgc3RyZWFtIG9iamVjdCB1c2VkDQogIFNldCBpblN0cmVhbSA9IENyZWF0ZU9iamVjdCgiQURPREIuU3RyZWFtIikNCiAgJyBvcGVuIHdpdGggbm8gYXJndW1lbnRzIG1ha2VzIHRoZSBzdHJlYW0gYW4gZW1wdHkgY29udGFpbmVyDQogIGluU3RyZWFtLk9wZW4NCiAgaW5TdHJlYW0uVHlwZSA9IFR5cGVCaW5hcnkNCiAgaW5TdHJlYW0uTG9hZEZyb21GaWxlIChmaWxlKQ0KICByZWFkQnl0ZXMgPSBpblN0cmVhbS5SZWFkKCkNCkVuZCBGdW5jdGlvbg0KUHJpdmF0ZSBGdW5jdGlvbiBjaHVua2lmeShCeVZhbCBiYXNlIEFzIFN0cmluZywgT3B0aW9uYWwgQnlWYWwgc3RyaW5nTGVuZ3RoIEFzIExvbmcgPSA5MDApIEFzIFN0cmluZw0KJ3NwbGl0cyBhIHN0cmluZyBhdCBldmVyeSBzdHJpbmdMZW5ndGggY2hhcmFjaHRlcnMgYW5kIGRlbGltaXRzDQonMTAyNCBpcyBtYXggY2hhcnMgaW4gYSBsaW5lDQpjaHVua2lmeSA9IEpvaW4oU3BsaXRTdHJpbmcoYmFzZSwgc3RyaW5nTGVuZ3Ro" & _
"KSwgIiAmIF8iICYgdmJDckxmKQ0KRW5kIEZ1bmN0aW9uDQoNClByaXZhdGUgRnVuY3Rpb24gU3BsaXRTdHJpbmcoQnlWYWwgc3RyIEFzIFN0cmluZywgQnlWYWwgbnVtT2ZDaGFyIEFzIExvbmcpIEFzIFN0cmluZygpDQogICAgRGltIHNBcnIoKSBBcyBTdHJpbmcNCiAgICBEaW0gbkNvdW50IEFzIExvbmcNCiAgICBSZURpbSBzQXJyKChMZW4oc3RyKSAtIDEpIFwgbnVtT2ZDaGFyKQ0KICAgIERvIFdoaWxlIExlbihzdHIpDQogICAgICAgIHNBcnIobkNvdW50KSA9ICIiIiIgJiBMZWZ0JChzdHIsIG51bU9mQ2hhcikgJiAiIiIiDQogICAgICAgIHN0ciA9IE1pZCQoc3RyLCBudW1PZkNoYXIgKyAxKQ0KICAgICAgICBuQ291bnQgPSBuQ291bnQgKyAxDQogICAgTG9vcA0KICAgIFNwbGl0U3RyaW5nID0gc0Fycg0KRW5kIEZ1bmN0aW9uDQoNClByaXZhdGUgRnVuY3Rpb24gVG9CYXNlNjQoZGF0YSgpIEFzIEJ5dGUpIEFzIFN0cmluZw0KICBEaW0gYjY0KDAgVG8gNjMpIEFzIEJ5dGUsIHN0cigpIEFzIEJ5dGUsIGkmLCBqJiwgdiYsIG4mDQogIG4gPSBVQm91bmQoZGF0YSkgLSBMQm91bmQoZGF0YSkgKyAxDQogIElmIG4gVGhlbiBFbHNlIEV4aXQgRnVuY3Rpb24NCg0KICBzdHIgPSAiQUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAxMjM0NTY3" & _
"ODkrLyINCiAgRm9yIGkgPSAwIFRvIDEyNyBTdGVwIDINCiAgICBiNjQoaSBcIDIpID0gc3RyKGkpDQogIE5leHQNCg0KICBSZURpbSBzdHIoMCBUbyAoKG4gKyAyKSBcIDMpICogOCAtIDEpDQoNCiAgRm9yIGkgPSBMQm91bmQoZGF0YSkgVG8gVUJvdW5kKGRhdGEpIC0gKG4gTW9kIDMpIFN0ZXAgMw0KICAgIHYgPSBkYXRhKGkpICogNjU1MzYgKyBkYXRhKGkgKyAxKSAqIDI1NiYgKyBkYXRhKGkgKyAyKQ0KICAgIHN0cihqKSA9IGI2NCh2IFwgMjYyMTQ0KQ0KICAgIHN0cihqICsgMikgPSBiNjQoKHYgXCA0MDk2KSBNb2QgNjQpDQogICAgc3RyKGogKyA0KSA9IGI2NCgodiBcIDY0KSBNb2QgNjQpDQogICAgc3RyKGogKyA2KSA9IGI2NCh2IE1vZCA2NCkNCiAgICBqID0gaiArIDgNCiAgTmV4dA0KDQogIElmIG4gTW9kIDMgPSAyIFRoZW4NCiAgICB2ID0gZGF0YShuIC0gMikgKiAyNTYmICsgZGF0YShuIC0gMSkNCiAgICBzdHIoaikgPSBiNjQoKHYgXCAxMDI0JikgTW9kIDY0KQ0KICAgIHN0cihqICsgMikgPSBiNjQoKHYgXCAxNikgTW9kIDY0KQ0KICAgIHN0cihqICsgNCkgPSBiNjQoKHYgKiA0KSBNb2QgNjQpDQogICAgc3RyKGogKyA2KSA9IDYxICcgPSAnDQogIEVsc2VJZiBuIE1vZCAzID0gMSBUaGVuDQogICAgdiA9IGRhdGEobiAtIDEpDQogICAgc3RyKGopID0gYjY0KHYgXCA0" & _
"IE1vZCA2NCkNCiAgICBzdHIoaiArIDIpID0gYjY0KHYgKiAxNiBNb2QgNjQpDQogICAgc3RyKGogKyA0KSA9IDYxICcgPSAnDQogICAgc3RyKGogKyA2KSA9IDYxICcgPSAnDQogIEVuZCBJZg0KDQogIFRvQmFzZTY0ID0gc3RyDQpFbmQgRnVuY3Rpb24NCg0KUHJpdmF0ZSBGdW5jdGlvbiBmaWxsTW9kdWxlKGNvZGVTZWN0aW9uIEFzIGNvZGVNb2R1bGUpIEFzIExvbmcoKQ0KV2l0aCBjb2RlU2VjdGlvbg0KLkluc2VydExpbmVzIDEsICJPcHRpb24gRXhwbGljaXQiDQouSW5zZXJ0TGluZXMgMiwgIlByaXZhdGUgVHlwZSBjb2RlSXRlbSINCi5JbnNlcnRMaW5lcyAzLCAiICAgIGV4dGVuc2lvbiBBcyBTdHJpbmciDQouSW5zZXJ0TGluZXMgNCwgIiAgICBtb2R1bGVfbmFtZSBBcyBTdHJpbmciDQouSW5zZXJ0TGluZXMgNSwgIiAgICBjb2RlX2NvbnRlbnQgQXMgU3RyaW5nIg0KLkluc2VydExpbmVzIDYsICJFbmQgVHlwZSINCi5JbnNlcnRMaW5lcyA3LCAiIg0KLkluc2VydExpbmVzIDgsICJQcml2YXRlIENvbnN0IFR5cGVCaW5hcnkgPSAxIg0KLkluc2VydExpbmVzIDksICJQcml2YXRlIENvbnN0IEZvclJlYWRpbmcgPSAxLCBGb3JXcml0aW5nID0gMiwgRm9yQXBwZW5kaW5nID0gOCINCi5JbnNlcnRMaW5lcyAxMCwgIiINCi5JbnNlcnRMaW5lcyAxMSwgIlByaXZhdGUgRnVuY3Rpb24g" & _
"Z2V0Q29kZURlZmluaXRpb24oaXRlbU5vIEFzIExvbmcpIEFzIGNvZGVJdGVtIg0KLkluc2VydExpbmVzIDEyLCAiICAgIFdpdGggZ2V0Q29kZURlZmluaXRpb24iDQouSW5zZXJ0TGluZXMgMTMsICIgICAgICAgIFNlbGVjdCBDYXNlIGl0ZW1ObyINCi5JbnNlcnRMaW5lcyAxNCwgIiAgICAgICAgICAgICd7MH0iDQouSW5zZXJ0TGluZXMgMTUsICIgICAgICAgIENhc2UgRWxzZSINCi5JbnNlcnRMaW5lcyAxNiwgIiAgICAgICAgICAgIC5leHRlbnNpb24gPSAiIm1pc3NpbmciIiINCi5JbnNlcnRMaW5lcyAxNywgIiAgICAgICAgRW5kIFNlbGVjdCINCi5JbnNlcnRMaW5lcyAxOCwgIiAgICBFbmQgV2l0aCINCi5JbnNlcnRMaW5lcyAxOSwgIkVuZCBGdW5jdGlvbiINCi5JbnNlcnRMaW5lcyAyMCwgIiINCi5JbnNlcnRMaW5lcyAyMSwgIlB1YmxpYyBTdWIgRXh0cmFjdCgpIg0KLkluc2VydExpbmVzIDIyLCAiICAgIERpbSBjb2RlX21vZHVsZSBBcyBjb2RlSXRlbSINCi5JbnNlcnRMaW5lcyAyMywgIiAgICBEaW0gc2F2ZWRQYXRoIEFzIFN0cmluZywgYmFzZVBhdGggQXMgU3RyaW5nIg0KLkluc2VydExpbmVzIDI0LCAiICAgIERpbSBpIEFzIExvbmciDQouSW5zZXJ0TGluZXMgMjUsICIgICAgJ2NoZWNrIGlmIHZicHJvamVjdCBhY2Nlc3NpYmxlIg0KLkluc2VydExpbmVzIDI2LCAiICAg" & _
"IElmIE5vdCBwcm9qZWN0X2FjY2Vzc2libGUgVGhlbiINCi5JbnNlcnRMaW5lcyAyNywgIiAgICAgICAgTXNnQm94ICIiVGhlIFZCQSBwcm9qZWN0IGNhbm5vdCBiZSBhY2Nlc3NlZCBwcm9ncmFtbWF0aWNhbGx5IiIiDQouSW5zZXJ0TGluZXMgMjgsICIgICAgICAgIEV4aXQgU3ViIg0KLkluc2VydExpbmVzIDI5LCAiICAgIEVuZCBJZiINCi5JbnNlcnRMaW5lcyAzMCwgIiAgICAnY2hlY2sgaWYgdGVtcCBmb2xkZXIgYWNlc3NpYmxlIg0KLkluc2VydExpbmVzIDMxLCAiICAgIGkgPSAwIg0KLkluc2VydExpbmVzIDMyLCAiICAgIGJhc2VQYXRoID0gRW52aXJvbigiIlRlbXAiIikgJiAiIlwiIiINCi5JbnNlcnRMaW5lcyAzMywgIiAgICBEbyBXaGlsZSBUcnVlIg0KLkluc2VydExpbmVzIDM0LCAiICAgICAgICBpID0gaSArIDEiDQouSW5zZXJ0TGluZXMgMzUsICIgICAgICAgIGNvZGVfbW9kdWxlID0gZ2V0Q29kZURlZmluaXRpb24oaSkiDQouSW5zZXJ0TGluZXMgMzYsICIgICAgICAgIElmIGNvZGVfbW9kdWxlLmV4dGVuc2lvbiA9ICIibWlzc2luZyIiIFRoZW4iDQouSW5zZXJ0TGluZXMgMzcsICIgICAgICAgICAgICBFeGl0IERvIg0KLkluc2VydExpbmVzIDM4LCAiICAgICAgICBFbHNlIg0KLkluc2VydExpbmVzIDM5LCAiICAgICAgICAgICAgc2F2ZWRQYXRoID0gY3JlYXRlRmls" & _
"ZShjb2RlX21vZHVsZSwgYmFzZVBhdGgpIg0KLkluc2VydExpbmVzIDQwLCAiICAgICAgICAgICAgaW1wb3J0RmlsZSBzYXZlZFBhdGgiDQouSW5zZXJ0TGluZXMgNDEsICIgICAgICAgICAgICBLaWxsIHNhdmVkUGF0aCINCi5JbnNlcnRMaW5lcyA0MiwgIiAgICAgICAgRW5kIElmIg0KLkluc2VydExpbmVzIDQzLCAiICAgIExvb3AiDQouSW5zZXJ0TGluZXMgNDQsICIgICAgcmVtb3ZlbW9kdWxlICIiezF9IiIiDQouSW5zZXJ0TGluZXMgNDUsICJFbmQgU3ViIg0KLkluc2VydExpbmVzIDQ2LCAiIg0KLkluc2VydExpbmVzIDQ3LCAiUHJpdmF0ZSBGdW5jdGlvbiBwcm9qZWN0X2FjY2Vzc2libGUoKSBBcyBCb29sZWFuIg0KLkluc2VydExpbmVzIDQ4LCAiICAgIE9uIEVycm9yIFJlc3VtZSBOZXh0Ig0KLkluc2VydExpbmVzIDQ5LCAiICAgIFdpdGggVGhpc1dvcmtib29rLlZCUHJvamVjdCINCi5JbnNlcnRMaW5lcyA1MCwgIiAgICAgICAgcHJvamVjdF9hY2Nlc3NpYmxlID0gLlByb3RlY3Rpb24gPSB2YmV4dF9wcF9ub25lIg0KLkluc2VydExpbmVzIDUxLCAiICAgICAgICBwcm9qZWN0X2FjY2Vzc2libGUgPSBwcm9qZWN0X2FjY2Vzc2libGUgQW5kIEVyci5OdW1iZXIgPSAwIg0KLkluc2VydExpbmVzIDUyLCAiICAgIEVuZCBXaXRoIg0KLkluc2VydExpbmVzIDUzLCAiRW5kIEZ1bmN0" & _
"aW9uIg0KLkluc2VydExpbmVzIDU0LCAiIg0KLkluc2VydExpbmVzIDU1LCAiUHJpdmF0ZSBGdW5jdGlvbiBjcmVhdGVGaWxlKGRlZmluaXRpb24gQXMgY29kZUl0ZW0sIGZpbGVQYXRoIEFzIFZhcmlhbnQpIEFzIFN0cmluZyINCi5JbnNlcnRMaW5lcyA1NiwgIiAgICBEaW0gY29kZUluZGV4IEFzIExvbmciDQouSW5zZXJ0TGluZXMgNTcsICIgICAgRGltIG5ld0ZpbGVPYmogQXMgT2JqZWN0Ig0KLkluc2VydExpbmVzIDU4LCAiICAgIFNldCBuZXdGaWxlT2JqID0gQ3JlYXRlT2JqZWN0KCIiQURPREIuU3RyZWFtIiIpIg0KLkluc2VydExpbmVzIDU5LCAiICAgIG5ld0ZpbGVPYmouVHlwZSA9IFR5cGVCaW5hcnkiDQouSW5zZXJ0TGluZXMgNjAsICIgICAgJ09wZW4gdGhlIHN0cmVhbSBhbmQgd3JpdGUgYmluYXJ5IGRhdGEiDQouSW5zZXJ0TGluZXMgNjEsICIgICAgbmV3RmlsZU9iai5PcGVuIg0KLkluc2VydExpbmVzIDYyLCAiICAgICdjcmVhdGUgZmlsZSBmcm9tIHg2NCBzdHJpbmciDQouSW5zZXJ0TGluZXMgNjMsICIgICAgV2l0aCBkZWZpbml0aW9uIg0KLkluc2VydExpbmVzIDY0LCAiICAgICAgICBEaW0gYnl0ZXMoKSBBcyBCeXRlIg0KLkluc2VydExpbmVzIDY1LCAiICAgICAgICBEaW0gZnVsbFBhdGggQXMgU3RyaW5nIg0KLkluc2VydExpbmVzIDY2LCAiICAgICAgICBmdWxs" & _
"UGF0aCA9IGZpbGVQYXRoICYgLm1vZHVsZV9uYW1lICYgLmV4dGVuc2lvbiINCi5JbnNlcnRMaW5lcyA2NywgIiAgICAgICAgYnl0ZXMgPSBGcm9tQmFzZTY0KC5jb2RlX2NvbnRlbnQpIg0KLkluc2VydExpbmVzIDY4LCAiICAgICAgICBuZXdGaWxlT2JqLldyaXRlIGJ5dGVzIg0KLkluc2VydExpbmVzIDY5LCAiICAgICAgICBuZXdGaWxlT2JqLlNhdmVUb0ZpbGUgZnVsbFBhdGgsIEZvcldyaXRpbmciDQouSW5zZXJ0TGluZXMgNzAsICIgICAgICAgIGNyZWF0ZUZpbGUgPSBmdWxsUGF0aCINCi5JbnNlcnRMaW5lcyA3MSwgIiAgICBFbmQgV2l0aCINCi5JbnNlcnRMaW5lcyA3MiwgIkVuZCBGdW5jdGlvbiINCi5JbnNlcnRMaW5lcyA3MywgIiINCi5JbnNlcnRMaW5lcyA3NCwgIlByaXZhdGUgU3ViIGltcG9ydEZpbGUoZmlsZVBhdGggQXMgU3RyaW5nKSINCi5JbnNlcnRMaW5lcyA3NSwgIiAgICBUaGlzV29ya2Jvb2suVkJQcm9qZWN0LlZCQ29tcG9uZW50cy5JbXBvcnQgZmlsZVBhdGgiDQouSW5zZXJ0TGluZXMgNzYsICJFbmQgU3ViIg0KLkluc2VydExpbmVzIDc3LCAiIg0KLkluc2VydExpbmVzIDc4LCAiUHJpdmF0ZSBGdW5jdGlvbiByZW1vdmVtb2R1bGUobW9kdWxlTmFtZSBBcyBTdHJpbmcpIEFzIEJvb2xlYW4iDQouSW5zZXJ0TGluZXMgNzksICIgICAgT24gRXJyb3IgUmVzdW1l" & _
"IE5leHQiDQouSW5zZXJ0TGluZXMgODAsICIgICAgV2l0aCBUaGlzV29ya2Jvb2suVkJQcm9qZWN0LlZCQ29tcG9uZW50cyINCi5JbnNlcnRMaW5lcyA4MSwgIiAgICAgICAgLlJlbW92ZSAuSXRlbShtb2R1bGVOYW1lKSINCi5JbnNlcnRMaW5lcyA4MiwgIiAgICBFbmQgV2l0aCINCi5JbnNlcnRMaW5lcyA4MywgIiAgICByZW1vdmVtb2R1bGUgPSBOb3QgKEVyci5OdW1iZXIgPSA5KSINCi5JbnNlcnRMaW5lcyA4NCwgIkVuZCBGdW5jdGlvbiINCi5JbnNlcnRMaW5lcyA4NSwgIiINCi5JbnNlcnRMaW5lcyA4NiwgIlByaXZhdGUgRnVuY3Rpb24gRnJvbUJhc2U2NChUZXh0IEFzIFN0cmluZykgQXMgQnl0ZSgpIg0KLkluc2VydExpbmVzIDg3LCAiICAgIERpbSBPdXQoKSBBcyBCeXRlIg0KLkluc2VydExpbmVzIDg4LCAiICAgIERpbSBiNjQoMCBUbyAyNTUpIEFzIEJ5dGUsIHN0cigpIEFzIEJ5dGUsIGkmLCBqJiwgdiYsIGIwJiwgYjEmLCBiMiYsIGIzJiINCi5JbnNlcnRMaW5lcyA4OSwgIiAgICBPdXQgPSAiIiIiIg0KLkluc2VydExpbmVzIDkwLCAiICAgIElmIExlbihUZXh0KSBUaGVuIEVsc2UgRXhpdCBGdW5jdGlvbiINCi5JbnNlcnRMaW5lcyA5MSwgIiINCi5JbnNlcnRMaW5lcyA5MiwgIiAgICBzdHIgPSAiIiBBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWmFiY2RlZmdoaWprbG1u" & _
"b3BxcnN0dXZ3eHl6MDEyMzQ1Njc4OSsvIiIiDQouSW5zZXJ0TGluZXMgOTMsICIgICAgRm9yIGkgPSAyIFRvIFVCb3VuZChzdHIpIFN0ZXAgMiINCi5JbnNlcnRMaW5lcyA5NCwgIiAgICAgICAgYjY0KHN0cihpKSkgPSBpIFwgMiINCi5JbnNlcnRMaW5lcyA5NSwgIiAgICBOZXh0Ig0KLkluc2VydExpbmVzIDk2LCAiIg0KLkluc2VydExpbmVzIDk3LCAiICAgIFJlRGltIE91dCgwIFRvICgoTGVuKFRleHQpICsgMykgXCA0KSAqIDMgLSAxKSINCi5JbnNlcnRMaW5lcyA5OCwgIiAgICBzdHIgPSBUZXh0ICYgU3RyaW5nJCgyLCAwKSINCi5JbnNlcnRMaW5lcyA5OSwgIiINCi5JbnNlcnRMaW5lcyAxMDAsICIgICAgRm9yIGkgPSAwIFRvIFVCb3VuZChzdHIpIC0gNyBTdGVwIDIiDQouSW5zZXJ0TGluZXMgMTAxLCAiICAgICAgICBiMCA9IGI2NChzdHIoaSkpIg0KLkluc2VydExpbmVzIDEwMiwgIiINCi5JbnNlcnRMaW5lcyAxMDMsICIgICAgICAgIElmIGIwIFRoZW4iDQouSW5zZXJ0TGluZXMgMTA0LCAiICAgICAgICAgICAgYjEgPSBiNjQoc3RyKGkgKyAyKSkiDQouSW5zZXJ0TGluZXMgMTA1LCAiICAgICAgICAgICAgYjIgPSBiNjQoc3RyKGkgKyA0KSkiDQouSW5zZXJ0TGluZXMgMTA2LCAiICAgICAgICAgICAgYjMgPSBiNjQoc3RyKGkgKyA2KSkiDQouSW5zZXJ0TGluZXMgMTA3LCAi" & _
"ICAgICAgICAgICAgdiA9IGIwICogMjYyMTQ0ICsgYjEgKiA0MDk2JiArIGIyICogNjQmICsgYjMgLSAyNjYzMDUiDQouSW5zZXJ0TGluZXMgMTA4LCAiICAgICAgICAgICAgT3V0KGopID0gdiBcIDY1NTM2Ig0KLkluc2VydExpbmVzIDEwOSwgIiAgICAgICAgICAgIE91dChqICsgMSkgPSAodiBcIDI1NiYpIE1vZCAyNTYiDQouSW5zZXJ0TGluZXMgMTEwLCAiICAgICAgICAgICAgT3V0KGogKyAyKSA9IHYgTW9kIDI1NiINCi5JbnNlcnRMaW5lcyAxMTEsICIgICAgICAgICAgICBqID0gaiArIDMiDQouSW5zZXJ0TGluZXMgMTEyLCAiICAgICAgICAgICAgaSA9IGkgKyA2Ig0KLkluc2VydExpbmVzIDExMywgIiAgICAgICAgRW5kIElmIg0KLkluc2VydExpbmVzIDExNCwgIiAgICBOZXh0Ig0KLkluc2VydExpbmVzIDExNSwgIiINCi5JbnNlcnRMaW5lcyAxMTYsICIgICAgSWYgYjIgPSAwIFRoZW4iDQouSW5zZXJ0TGluZXMgMTE3LCAiICAgICAgICBPdXQoaiAtIDMpID0gKHYgKyA2NSkgXCA2NTUzNiINCi5JbnNlcnRMaW5lcyAxMTgsICIgICAgICAgIGogPSBqIC0gMiINCi5JbnNlcnRMaW5lcyAxMTksICIgICAgRWxzZUlmIGIzID0gMCBUaGVuIg0KLkluc2VydExpbmVzIDEyMCwgIiAgICAgICAgT3V0KGogLSAzKSA9ICh2ICsgMSkgXCA2NTUzNiINCi5JbnNlcnRMaW5lcyAxMjEsICIg" & _
"ICAgICAgIE91dChqIC0gMikgPSAoKHYgKyAxKSBcIDI1NiYpIE1vZCAyNTYiDQouSW5zZXJ0TGluZXMgMTIyLCAiICAgICAgICBqID0gaiAtIDEiDQouSW5zZXJ0TGluZXMgMTIzLCAiICAgIEVuZCBJZiINCi5JbnNlcnRMaW5lcyAxMjQsICIiDQouSW5zZXJ0TGluZXMgMTI1LCAiICAgIFJlRGltIFByZXNlcnZlIE91dChqIC0gMSkiDQouSW5zZXJ0TGluZXMgMTI2LCAiICAgIEZyb21CYXNlNjQgPSBPdXQiDQouSW5zZXJ0TGluZXMgMTI3LCAiRW5kIEZ1bmN0aW9uIg0KRGltIHJlc3VsdCgwIFRvIDEpIEFzIExvbmcNCklmIC5GaW5kKCJ7MH0iLCByZXN1bHQoMCksIHJlc3VsdCgxKSwgLTEsIC0xKSBUaGVuICdzZWFyY2ggZm9yIHBvaW50IHRvIGluc2VydCBsaW5lcw0KICAgIGZpbGxNb2R1bGUgPSByZXN1bHQNCkVsc2UNCiAgICByZXN1bHQoMCkgPSAwDQogICAgcmVzdWx0KDEpID0gMA0KICAgIGZpbGxNb2R1bGUgPSByZXN1bHQNCkVuZCBJZg0KRW5kIFdpdGgNCkVuZCBGdW5jdGlvbg0KDQoNCg0K"
According to the docs, linefeed character vbCrLf should just make code on separate lines (what I want), so that shouldn't be causing the error.
However the length of string is not the problem either, as if .value = String(19000,"a") I have no issues. What's the cause of this error and how do I get around it?
Update
Something more re-createable:
Sub testAdd()
Dim codeStuff As codeModule
On Error Resume Next
Set codeStuff = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).codeModule
'check for vbProj access
If Err.Number <> 0 Then MsgBox "Access to VBProject disabled": Exit Sub
On Error GoTo 0
'try to add code
With codeStuff
Dim i As Long
For i = 1 To 3
'i = 1 fails for me
On Error Resume Next
.InsertLines 1, exampleString(i) 'causes the error
Debug.Print "Case"; i; IIf(Err.Number = 0, " suceeded", " failed with err:" & Err.Number)
On Error GoTo -1
Next i
End With
ThisWorkbook.VBProject.VBComponents.Remove codeStuff.Parent
End Sub
Function exampleString(stringType As Long) As String
Dim result As String
Select Case stringType
Case 1 'lots of linefeed
Dim bit As Long
For bit = 1 To 19
result = result & """" & String(1000, "a") & """ & _" & vbCrLf
Next bit
result = result & """" & String(1000, "a") & """"
Case 2 'long string
result = String(20000, "a")
Case Else 'short string
result = String(100, "a")
End Select
exampleString = result
End Function
There is a limit of "prolonging" lines with _ at the end, try building your string part by part:
.code_content = "first part"
.code_content = .code_content & "second part"
I want to test whether certain sheets in the current workbook exist in another closed workbook and return a message saying which sheet/s are causing errors.
I prefer not to open/close the workbook so I'm trying to change the formula in a random cell to link to the workbook of filepath (fp) to test whether the sheet exists.
I've tested this with a dummy sheet that I know doesn't exist in the other workbook and it works but when I have more than one sheet that causes errors I get an "Application-defined or object-defined error". On the second iteration I believe the way the error handling is written causes the crash but I don't exactly understand how that works.
The code I've got is:
Sub SheetTest(ByVal fp As String)
Dim i, errcount As Integer
Dim errshts As String
For i = 2 To Sheets.Count
On Error GoTo NoSheet
Sheets(1).Range("A50").Formula = "='" & fp & Sheets(i).Name & "'!A1"
GoTo NoError
NoSheet:
errshts = errshts & "'" & Sheets(i).Name & "', "
errcount = errcount + 1
NoError:
Next i
Sheets(1).Range("A50").ClearContents
If Not errshts = "" Then
If errcount = 1 Then
MsgBox "Sheet " & Left(errshts, Len(errshts) - 2) & " does not exist in the Output file. Please check the sheet name or select another Output file."
Else
MsgBox "Sheets " & Left(errshts, Len(errshts) - 2) & " do not exist in the Output file. Please check each sheet's name or select another Output file."
End If
End
End If
End Sub
Hopefully you guys can help me out here, thanks!
Here's a slightly different approach:
Sub Tester()
Dim s As Worksheet
For Each s In ThisWorkbook.Worksheets
Debug.Print s.Name, HasSheet("C:\Users\blah\Desktop\", "temp.xlsm", s.Name)
Next s
End Sub
Function HasSheet(fPath As String, fName As String, sheetName As String)
Dim f As String
f = "'" & fPath & "[" & fName & "]" & sheetName & "'!R1C1"
HasSheet = Not IsError(Application.ExecuteExcel4Macro(f))
End Function
Just an update for Tim's Function for error Handling:
VBA:
Function HasSheet(fPath As String, fName As String, sheetName As String)
On Error Resume Next
Dim f As String
f = "'" & fPath & "[" & fName & "]" & sheetName & "'!R1C1"
HasSheet = Not IsError(Application.ExecuteExcel4Macro(f))
If Err.Number <> 0 Then
HasSheet = False
End If
On Error GoTo 0
End Function
Sub Tester()
MsgBox (Not IsError(Application.ExecuteExcel4Macro("'C:\temp[temp.xlsm]Sheetxyz'!R1C1")))
End Sub
This is more an observation than a real question: MS-Access (and VBA in general) is desperately missing a tool where error handling code can be generated automatically, and where the line number can be displayed when an error occurs. Did you find a solution? What is it? I just realized how many hundreds of hours I spared since I found the right answer to this basic problem a few years ago, and I'd like to see what are your ideas and solutions on this very important issue.
What about using "Erl", it will display the last label before the error (e.g., 10, 20, or 30)?
Private Sub mySUB()
On Error GoTo Err_mySUB
10:
Dim stDocName As String
Dim stLinkCriteria As String
20:
stDocName = "MyDoc"
30:
DoCmd.openform stDocName, acFormDS, , stLinkCriteria
Exit_mySUB:
Exit Sub
Err_mySUB:
MsgBox Err.Number & ": " & Err.Description & " (" & Erl & ")"
Resume Exit_mySUB
End Sub
My solution is the following:
install MZ-Tools, a very interesting add-on for VBA. No they did not pay me to write this. Version 3 was free, but since version 8.0, the add-in is commercially sold.
program a standard error handler code such as this one (see MZ-Tools menu/Options/Error handler):
On Error GoTo {PROCEDURE_NAME}_Error
{PROCEDURE_BODY}
On Error GoTo 0
Exit {PROCEDURE_TYPE}
{PROCEDURE_NAME}_Error:
debug.print "#" & Err.Number, Err.description, "l#" & erl, "{PROCEDURE_NAME}", "{MODULE_NAME}"
This standard error code can be then automatically added to all of your procs and function by clicking on the corresponding button in the MZ-Tools menu. You'll notice that we refer here to a hidden and undocumented function in the VBA standard library, 'Erl', which stands for 'error line'. You got it! If you ask MZ-Tools to automatically number your lines of code, 'Erl' will then give you the number of the line where the error occured. You will have a complete description of the error in your immediate window, such as:
#91, Object variable or With block variable not set, l# 30, addNewField, Utilities
Of course, once you realize the interest of the system, you can think of a more sophisticated error handler, that will not only display the data in the debug window but will also:
display it as a message on the screen
Automatically insert a line in an error log file with the description of the error or
if you are working with Access or if you are connected to a database, automatically add a record to a Tbl_Error table!
meaning that each error generated at the user level can be stored either in a file or a table, somewhere on the machine or the network. Are we talking about building an automated error reporting system working with VBA?
Well there are a couple of tools that will do what you ask MZ Tools and FMS Inc come to mind.
Basically they involve adding an:
On Error GoTo ErrorHandler
to the top of each proc
and at the end they put an:
ErrorHandler:
Call MyErrorhandler Err.Number, Err.Description, Err.LineNumber
label with usually a call to a global error handler where you can display and log custom error messages
You can always roll your own tool like Chip Pearson did. VBA can actually access it's own IDE via the Microsoft Visual Basic for Applications Extensibility 5.3 Library. I've written a few class modules that make it easier to work with myself. They can be found on Code Review SE.
I use it to insert On Error GoTo ErrHandler statements and the appropriate labels and constants related to my error handling schema. I also use it to sync up the constants with the actual procedure names (if the function names should happen to change).
There is no need to buy tools DJ mentioned. Here is my code for free:
Public Sub InsertErrHandling(modName As String)
Dim Component As Object
Dim Name As String
Dim Kind As Long
Dim FirstLine As Long
Dim ProcLinesCount As Long
Dim Declaration As String
Dim ProcedureType As String
Dim Index As Long, i As Long
Dim LastLine As Long
Dim StartLines As Collection, LastLines As Collection, ProcNames As Collection, ProcedureTypes As Collection
Dim gotoErr As Boolean
Kind = 0
Set StartLines = New Collection
Set LastLines = New Collection
Set ProcNames = New Collection
Set ProcedureTypes = New Collection
Set Component = Application.VBE.ActiveVBProject.VBComponents(modName)
With Component.CodeModule
' Remove empty lines on the end of the code
For i = .CountOfLines To 1 Step -1
If Component.CodeModule.Lines(i, 1) = "" Then
Component.CodeModule.DeleteLines i, 1
Else
Exit For
End If
Next i
Index = .CountOfDeclarationLines + 1
Do While Index < .CountOfLines
gotoErr = False
Name = .ProcOfLine(Index, Kind)
FirstLine = .ProcBodyLine(Name, Kind)
ProcLinesCount = .ProcCountLines(Name, Kind)
Declaration = Trim(.Lines(FirstLine, 1))
LastLine = FirstLine + ProcLinesCount - 2
If InStr(1, Declaration, "Function ", vbBinaryCompare) > 0 Then
ProcedureType = "Function"
Else
ProcedureType = "Sub"
End If
Debug.Print Component.Name & "." & Name, "First: " & FirstLine, "Lines:" & ProcLinesCount, "Last: " & LastLine, Declaration
Debug.Print "Declaration: " & Component.CodeModule.Lines(FirstLine, 1), FirstLine
Debug.Print "Closing Proc: " & Component.CodeModule.Lines(LastLine, 1), LastLine
' do not insert error handling if there is one already:
For i = FirstLine To LastLine Step 1
If Component.CodeModule.Lines(i, 1) Like "*On Error*" Then
gotoErr = True
Exit For
End If
Next i
If Not gotoErr Then
StartLines.Add FirstLine
LastLines.Add LastLine
ProcNames.Add Name
ProcedureTypes.Add ProcedureType
End If
Index = FirstLine + ProcLinesCount + 1
Loop
For i = LastLines.Count To 1 Step -1
If Not (Component.CodeModule.Lines(StartLines.Item(i) + 1, 1) Like "*On Error GoTo *") Then
Component.CodeModule.InsertLines LastLines.Item(i), "ExitProc_:"
Component.CodeModule.InsertLines LastLines.Item(i) + 1, " Exit " & ProcedureTypes.Item(i)
Component.CodeModule.InsertLines LastLines.Item(i) + 2, "ErrHandler_:"
Component.CodeModule.InsertLines LastLines.Item(i) + 3, " Call LogError(Err, Me.Name, """ & ProcNames.Item(i) & """)"
Component.CodeModule.InsertLines LastLines.Item(i) + 4, " Resume ExitProc_"
Component.CodeModule.InsertLines LastLines.Item(i) + 5, " Resume ' use for debugging"
Component.CodeModule.InsertLines StartLines.Item(i) + 1, " On Error GoTo ErrHandler_"
End If
Next i
End With
End Sub
Put it in a module and call it from Immediate Window every time you add new function or sub to a form or module like this (Form1 is name of your form):
MyModule.InsertErrHandling "Form_Form1"
It will alter your ode in Form1 from this:
Private Function CloseIt()
DoCmd.Close acForm, Me.Name
End Function
to this:
Private Function CloseIt()
On Error GoTo ErrHandler_
DoCmd.Close acForm, Me.Name
ExitProc_:
Exit Function
ErrHandler_:
Call LogError(Err, Me.Name, "CloseIt")
Resume ExitProc_
Resume ' use for debugging
End Function
Create now in a module a Sub which will display the error dialog and where you can add inserting the error to a text file or database:
Public Sub LogError(ByVal objError As ErrObject, moduleName As String, Optional procName As String = "")
On Error GoTo ErrHandler_
Dim sql As String
MsgBox "Error " & Err.Number & " Module " & moduleName & Switch(procName <> "", " in " & procName) & vbCrLf & " (" & Err.Description & ") ", vbCritical
Exit_:
Exit Sub
ErrHandler_:
MsgBox "Error in LogError procedure " & Err.Number & ", " & Err.Description
Resume Exit_
Resume ' use for debugging
End Sub
This code does not enter error handling if there is already "On Error" statement in a proc.
Love it Vlado!
I realize this is an old post, but I grabbed it and gave it a try, but I ran into a number of issues with it, which I managed to fix. Here's the code with fixes:
First of course, be sure to add the "Microsoft Visual Basic for Applications Extensibility 5.3" library to your project, and add these subroutines / modules to your project as well.
First, the module with the main code was named "modVBAChecks", and contained the following two subroutines:
To go through all modules (behind forms, sheets, the workbook, and classes as well, though not ActiveX Designers):
Sub AddErrorHandlingToAllProcs()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim lCtr As Long
StartNewWorksheetLog
Set VBProj = Workbooks("LabViewAnalysisTools.xla").VBProject
For Each VBComp In VBProj.VBComponents
If VBComp.Type <> vbext_ct_ActiveXDesigner Then
If VBComp.Name <> "modVBAChecks" And VBComp.Name <> "modLogToWorksheet" Then
AddToWksLog "============ Looking at Module """ & VBComp.Name & """"
'InsertErrHandling VBComp.Name
AddToWksLog
AddToWksLog
End If
End If
Next
MsgBox "Done!", vbSystemModal
End Sub
Then the modified version of your code (including a suggested change by
Rafał B.):
Public Sub InsertErrHandling(modsProcName As String)
' Modified from code submitted to StackOverflow by user Vlado, originally found
' here: https://stackoverflow.com/questions/357822/automatically-generating-handling-of-issues
Dim vbcmA As VBIDE.CodeModule
Dim ProcKind As VBIDE.vbext_ProcKind
Dim LineProcKind As VBIDE.vbext_ProcKind
Dim sProcName As String
Dim sLineProcName As String
Dim lFirstLine As Long
Dim lProcLinesCount As Long
Dim lLastLine As Long
Dim sDeclaration As String
Dim sProcType As String
Dim lLine As Long, lLine2 As Long
Dim sLine As String
Dim lcStartLines As Collection, lcLastlines As Collection, scProcsProcNames As Collection, scProcTypes As Collection
Dim bAddHandler As Boolean
Dim lLinesAbove As Long
Set lcStartLines = New Collection
Set lcLastlines = New Collection
Set scProcsProcNames = New Collection
Set scProcTypes = New Collection
Set vbcmA = Application.VBE.ActiveVBProject.VBComponents(modsProcName).CodeModule
' Remove empty lines on the end of the module. Cleanup, not error handling.
lLine = vbcmA.CountOfLines
If lLine = 0 Then Exit Sub ' Nothing to do!
Do
If Trim(vbcmA.Lines(lLine, 1)) <> "" Then Exit Do
vbcmA.DeleteLines lLine, 1
lLine = lLine - 1
Loop
lLine = vbcmA.CountOfDeclarationLines + 1
Do While lLine < vbcmA.CountOfLines
bAddHandler = False
' NOTE: ProcKind is RETRUNED from ProcOfLine!
sProcName = vbcmA.ProcOfLine(lLine, ProcKind)
' Fortunately ProcBodyLine ALWAYS returns the first line of the procedure declaration!
lFirstLine = vbcmA.ProcBodyLine(sProcName, ProcKind)
sDeclaration = Trim(vbcmA.Lines(lFirstLine, 1))
Select Case ProcKind
Case VBIDE.vbext_ProcKind.vbext_pk_Proc
If sDeclaration Like "*Function *" Then
sProcType = "Function"
ElseIf sDeclaration Like "*Sub *" Then
sProcType = "Sub"
End If
Case VBIDE.vbext_ProcKind.vbext_pk_Get, VBIDE.vbext_ProcKind.vbext_pk_Let, VBIDE.vbext_ProcKind.vbext_pk_Set
sProcType = "Property"
End Select
' The "lProcLinesCount" function will sometimes return ROWS ABOVE
' the procedure, possibly up until the prior procedure,
' and often rows BELOW the procedure as well!!!
lProcLinesCount = vbcmA.ProcCountLines(sProcName, ProcKind)
lLinesAbove = 0
lLine2 = lFirstLine - 1
If lLine2 > 0 Then
Do
sLineProcName = vbcmA.ProcOfLine(lLine2, LineProcKind)
If Not (sLineProcName = sProcName And LineProcKind = ProcKind) Then Exit Do
lLinesAbove = lLinesAbove + 1
lLine2 = lLine2 - 1
If lLine2 = 0 Then Exit Do
Loop
End If
lLastLine = lFirstLine + lProcLinesCount - lLinesAbove - 1
' Now need to trim off any follower lines!
Do
sLine = Trim(vbcmA.Lines(lLastLine, 1))
If sLine = "End " & sProcType Or sLine Like "End " & sProcType & " '*" Then Exit Do
lLastLine = lLastLine - 1
Loop
AddToWksLog modsProcName & "." & sProcName, "First: " & lFirstLine, "Lines:" & lProcLinesCount, "Last: " & lLastLine
AddToWksLog "sDeclaration: " & vbcmA.Lines(lFirstLine, 1), lFirstLine
AddToWksLog "Closing Proc: " & vbcmA.Lines(lLastLine, 1), lLastLine
If lLastLine - lFirstLine < 8 Then
AddToWksLog " --------------- Too Short to bother!"
Else
bAddHandler = True
' do not insert error handling if there is one already:
For lLine2 = lFirstLine To lLastLine Step 1
If vbcmA.Lines(lLine2, 1) Like "*On Error GoTo *" And Not vbcmA.Lines(lLine2, 1) Like "*On Error GoTo 0" Then
bAddHandler = False
Exit For
End If
Next lLine2
If bAddHandler Then
lcStartLines.Add lFirstLine
lcLastlines.Add lLastLine
scProcsProcNames.Add sProcName
scProcTypes.Add sProcType
End If
End If
AddToWksLog
lLine = lFirstLine + lProcLinesCount + 1
Loop
For lLine = lcLastlines.Count To 1 Step -1
vbcmA.InsertLines lcLastlines.Item(lLine), "ExitProc:"
vbcmA.InsertLines lcLastlines.Item(lLine) + 1, " Exit " & scProcTypes.Item(lLine)
vbcmA.InsertLines lcLastlines.Item(lLine) + 2, "ErrHandler:"
vbcmA.InsertLines lcLastlines.Item(lLine) + 3, " ShowErrorMsg Err, """ & scProcsProcNames.Item(lLine) & """, """ & modsProcName & """"
vbcmA.InsertLines lcLastlines.Item(lLine) + 4, " Resume ExitProc"
' Now replace any "On Error Goto 0" lines with "IF ErrorTrapping Then On Error Goto ErrHandler"
For lLine2 = lcStartLines(lLine) To lcLastlines(lLine)
sLine = vbcmA.Lines(lLine2, 1)
If sLine Like "On Error GoTo 0" Then
vbcmA.ReplaceLine lLine2, Replace(sLine, "On Error Goto 0", "IF ErrorTrapping Then On Error Goto ErrHandler")
End If
Next
lLine2 = lcStartLines.Item(lLine)
Do
sLine = vbcmA.Lines(lLine2, 1)
If Not sLine Like "* _" Then Exit Do
lLine2 = lLine2 + 1
Loop
vbcmA.InsertLines lLine2 + 1, " If ErrorTrapping Then On Error GoTo ErrHandler"
Next lLine
End Sub
And rather than pushing things to the Immediate window I used subroutines in a module I named "modLogToWorksheet", the full module being here:
Option Explicit
Private wksLog As Worksheet
Private lRow As Long
Public Sub StartNewWorksheetLog()
Dim bNewSheet As Boolean
bNewSheet = True
If ActiveSheet.Type = xlWorksheet Then
Set wksLog = ActiveSheet
bNewSheet = Not (wksLog.UsedRange.Cells.Count = 1 And wksLog.Range("A1").Formula = "")
End If
If bNewSheet Then Set wksLog = ActiveWorkbook.Worksheets.Add
lRow = 1
End Sub
Public Sub AddToWksLog(ParamArray sMsg() As Variant)
Dim lCol As Long
If wksLog Is Nothing Or lRow = 0 Then StartNewWorksheetLog
If Not (IsNull(sMsg)) Then
For lCol = 0 To UBound(sMsg)
If sMsg(lCol) <> "" Then wksLog.Cells(lRow, lCol + 1).Value = "'" & sMsg(lCol)
Next
End If
lRow = lRow + 1
End Sub
And finally, here's my Error Dialog generator:
Public Sub ShowErrorMsg(errThis As ErrObject, strSubName As String, strModName As String _
, Optional vbMBStyle As VbMsgBoxStyle = vbCritical, Optional sTitle As String = APP_TITLE)
If errThis.Number <> 0 Then
MsgBox "An Error Has Occurred in the Add-in. Please inform " & ADMINS & " of this problem." _
& vbCrLf & vbCrLf _
& "Error #: " & errThis.Number & vbCrLf _
& "Description: " & " " & errThis.Description & vbCrLf _
& "Subroutine: " & " " & strSubName & vbCrLf _
& "Module: " & " " & strModName & vbCrLf _
& "Source: " & " " & errThis.Source & vbCrLf & vbCrLf _
& "Click OK to continue.", vbMBStyle Or vbSystemModal, sTitle
End If
End Sub
Hope future users find it useful!