run time error 9 subscript out of range when selecting workbook
I am trying to build a data entry form in Excel 2010 using VBA. During form initialization I am setting an object to refer to another worksheet so I can access it. This is what I have:
Private Sub UserForm_Initialize() Dim master As Excel.Workbook Dim masterworksheetFmn As Excel.Worksheet Dim masterworksheetAdv As Excel.Worksheet Dim masterworksheetTechs As Excel.Worksheet Dim i As Integer Set master = Excel.Workbooks("ServiceReturnsMaster.xlsm") Set masterworksheetFmn = master.Worksheets("Foremen") Set masterworksheetAdv = master.Worksheets("Advisors") Set masterworksheetTechs = master.Worksheets("Techs")
When I run the macro, I get "Run Time error9: Subscript out of range". This occurs at this line:
Set master = Excel.Workbooks("ServiceReturnsMaster.xlsm")
HOWEVER, the error does not occur if I open the 2nd workbook before running the macro. I am assuming I have to activate the second workbook or something first or my reference is not written correctly. I can find lots of references to this run-time error, but none that directly address what I'm trying to do. What am I doing wrong?
When you use
Excel.Workbooksyou are referring to a generic
Workbookscollection. If you want to access the
Workbookscollection that is in your current application, then you need to use
You can also use it without the
Applicationqualifier as it's assumed you are working in the current application instance, so
Set master = Application.Workbooks("ServiceReturnsMaster.xlsm")
Set master = Workbooks("ServiceReturnsMaster.xlsm")
Should both work identically.
Alternatively, if your workbook isn't open at runtime, then you need to use the
Set master = Workbooks.Open("C:\Path\to\ServiceReturnsMaster.xlsm")
See also questions close to this topic
VBA Excel Value shows as integer while is text
I am attempting to do a Vlookup in VBA, and I am getting a
type mismatch Error 13.
The code is Below:
Dim CSVName As String Dim ThisBook As String Dim Vlook As Variant Vlook = Application.VLookup(Workbooks(CSVName).Worksheets(Sheet1).Range("A1").Value, Workbooks(ThisBook).Worksheets("Macro").Range("N1:N50").Value, 1, False)
When I apply the CSVName Value to the watches window it comes up with Type (Variant/Int) When the file in questions has text in it The cell contains ("BALANCING_SEGMENT"). Which I cannot figure out. What am I missing here? The purpose of this is to check the value in CSVName against the list and return a 1 if its in the list and not if its not, then process an if statement.
Using VBA, print an array made in Word to Excel
I am a VBA novice and I am trying to print an array that I was able to make (basically copying from another post) in VBA today. I placed a break into the script and inspected the array in the locals page to see that the array captures what I want (and some extra data that I will filter out). I spent the day reading about printing arrays on stack overflow and other sites and I ended up a bit lost. My goal is to export the array as a table in excel.
The script looks for underlined sentences in a 400 page word document and places them into the array. All that's really necessary for printing is the underlined sentences, so maybe an array wasn't the best approach? How can I export the array 'myWords' to a fresh excel document or one that I designate?
Many thanks for your help!
Sub addUnderlinedWordsToArray() On Error GoTo errhand: Dim myWords() As String Dim i As Long Dim myDoc As Document: Set myDoc = ActiveDocument ' Change as needed Dim aRange As Range: Set aRange = myDoc.Content Dim sRanges As StoryRanges: Set sRanges = myDoc.StoryRanges Dim ArrayCounter As Long: ArrayCounter = 0 ' counter for items added to the array Dim Sentence As Range Dim w As Variant Application.ScreenUpdating = False ReDim myWords(aRange.Words.Count) ' set a array as large as the ' number of words in the doc For Each Sentence In ActiveDocument.StoryRanges For Each w In ActiveDocument.Sentences If w.Font.Underline <> wdUnderlineNone Then myWords(ArrayCounter) = w ArrayCounter = ArrayCounter + 1 End If Next Next Set myDoc = Nothing Set aRange = Nothing Set sRange = Nothing Application.ScreenUpdating = True Exit Sub errhand: Application.ScreenUpdating = True MsgBox "An unexpected error has occurred." _ & vbCrLf & "Please note and report the following information." _ & vbCrLf & "Subroutine Name: addUnderlinedWordsToArray" _ & vbCrLf & "Error Number: " & Err.Number _ & vbCrLf & "Error Description: " & Err.Description _ , vbCritical, "Error!" End Sub
High lighting 2 cells in Excel if value on another sheet is greater/less than either of the values
I have 2 cells on one sheet in excel that pull in external data. The higher value is in the top cell and the lower value in the lower cell. I want to highlight both cells if a third value on another sheet is greater than the high value or lower than the lower value on the first page.
I have tried using conditional formatting by selecting both cells and making 2 different rules for those 2 cells but it doesn't seem to work. I have tried using the OR function and only making one rule but that hasn't worked either.
Any ideas on the best way to do this? I want both cells to be highlighted.
Access Vba can't find the Syntax error in Insert Into
I'm writing the following VBA code for a button in an Access form. I want the information inserted by the user to add a new record to a specific table, the table Cliente.
Private Sub novo_cliente_Click() Dim Id_Cliente As Integer Dim Primeiro_Nome As String Dim Ultimo_Nome As String Dim NIF As String Dim E_Cliente As String Dim Sexo As String Dim Contacto As String Dim Endereco As String Dim Localidade As String Dim Data_Nascimento As Date Dim Email As String Id_Cliente = Me.Id_Cliente.Value Primeiro_Nome = Nz(Me.Primeiro_Nome.Value, Empty) Ultimo_Nome = Nz(Me.Ultimo_Nome.Value, Empty) NIF = Nz(Me.NIF.Value, Empty) E_Cliente = Nz(Me.E_Cliente.Value, Empty) Sexo = Nz(Me.Sexo.Value, Empty) Contacto = Nz(Me.Contacto.Value, Empty) Endereco = Nz(Me.Endereco.Value, Empty) Localidade = Nz(Me.Localidade.Value, Empty) Data_Nascimento = Nz(Me.Data_Nascimento.Value, Empty) Email = Nz(Me.Email.Value, Empty) 'If IdCliente, NIF e e_Cliente empty If IsNull(Me.Id_Cliente.Value) = True Or IsNull(Me.NIF.Value) = True Or IsNull(Me.E_Cliente.Value) = True Then MsgBox "Please insert data in the required fields", vbExclamation, "Warning" Else DoCmd.RunSQL "INSERT INTO Cliente (Id_Cliente, Primeiro_Nome, Ultimo_Nome, NIF, Cliente?, Sexo, Contacto, Endereco, Localidade, Data Nascimento, Email) VALUES (Id_Cliente,'" & Primeiro_Nome & "', '" & Ultimo_Nome & "', '" & NIF & "', E_Cliente, Sexo, '" & Contacto & "', '" & Endereco & "', '" & Localidade & "', Data_Nascimento, '" & Email & "')" Me.Id_Cliente.Value = Empty Me.Primeiro_Nome.Value = Empty Me.Ultimo_Nome.Value = Empty Me.NIF.Value = Empty Me.E_Cliente.Value = Empty Me.Sexo.Value = Empty Me.Contacto.Value = Empty Me.Endereco.Value = Empty Me.Localidade.Value = Empty Me.Data_Nascimento.Value = Empty Me.Email.Value = Empty End If End Sub
Right now, I'm getting a syntax error in INSERT INTO statement, but I cannot find the error. Is it in "Cliente?" ? Thank you.
ListBox Control: First Row Disappears
REPOST from my question yesterday. Complete code below: I think the problem is at .Column = MyArray where I send the values into the Listbox thru .column instead of .additem. But i can't figure out how to .additem an array.
Option Explicit Dim MyArray As Variant Dim n As Integer Private Sub UserForm_initialize() n = 0 End Sub Private Sub FBcv_aDD_Click() ReDim MyArray(4, n) Dim i As Long '============================================ If ListBox_FB.ListIndex = True Then MyArray(0, n) = "Cavity Fixing Block" MyArray(1, n) = FBcv_L.Value & " x " & FBcv_W.Value & " x " & FBcv_T.Value If FBcv_Qty <= 1 Then MyArray(2, n) = FBcv_Qty.Value & "pc." ElseIf FBcv_Qty > 1 Then MyArray(2, n) = FBcv_Qty.Value & "pcs." End If MyArray(3, n) = FBmat.Value MyArray(4, n) = FBcv_uPRICE.Value n = n + 1 End If '============================================ With ListBox_FB For i = 0 To ListBox_FB.ListCount - 1 If ListBox_FB.ListIndex = False Then .AddItem ListBox_FB.List(i, 0) ListBox_FB.List(ListBox_FB.ListCount - 1, 1) = ListBox_FB.List(i, 1) ListBox_FB.List(ListBox_FB.ListCount - 1, 2) = ListBox_FB.List(i, 2) ListBox_FB.List(ListBox_FB.ListCount - 1, 3) = ListBox_FB.List(i, 3) ListBox_FB.List(ListBox_FB.ListCount - 1, 4) = ListBox_FB.List(i, 4) End If Next i .ColumnCount = 5 .TextAlign = 1 .Column = MyArray End With End Sub
Sorry I had to repost this, i messed up with my first question.
Can anyone help me sort this out? Any help is highly appreciated. Thanks in advanCce.
excel vba Code Stopping While Looping through files on workbook.close
I am trying to loop through some excel files, open them, run some code that breaks passwords then closes the workbook and moves to the next. My code works on most of my files however I am having trouble with files that have macros in them. (Not sure if that is the problem but thats the only thing I can see that differentiates these files from the others)
I have noticed that with the problem files when I open them my wb variable is set to nothing. I am very confused because it still opens the file and my code continues to run. But when I execute the line wb.close my code just stops. No error message but it doesnt even finish the loop that it is in.
Not sure if there is a way to attach a file that works and one that doesn't but I can if someone can explain how to do this. Thank you for any help.
When I open a file that doesnt cause this problem, In the locals window when I expand the variable wb, it has other attributes. On the problem files when I expand the wb variable it just says: no variables
When I open one of these files without using vba I get a warning that it contains a possible security concern and that macros have been disabled. I think that is where my problem is coming from however I thought I as handling this with Application.AutomationSecurity = msoAutomationSecurityForceDisable
I have updated my code to the following but it has not solved the problem of stopping the code on wb.close
Do While fileName <> vbNullString Set wb = Workbooks.Open(fileName:=directory & fileName, _ UpdateLinks:=0, _ IgnoreReadOnlyRecommended:=True, _ Notify:=False, _ CorruptLoad:=xlNormalLoad) If Err.Number = 0 And Not wb Is Nothing Then On Error GoTo 0 Call AllInternalPasswords wb.Close True fileName = Dir() Else Err.Clear On Error GoTo 0 End If Loop
Sub TestPasswordLoop() Dim directory As String, fileName As String, i As Variant, wb As Workbook Application.DisplayAlerts = False Application.ScreenUpdating = False Dim security As MsoAutomationSecurity security = Application.AutomationSecurity Application.AutomationSecurity = msoAutomationSecurityForceDisable directory = "C:\Users\seth\Desktop\Files for Testing\" fileName = Dir(directory & "*.xl??") i = 0 Do While fileName <> vbNullString On Error Resume Next 'Set wb = Workbooks.Open(fileName:=directory & fileName) Set wb = Workbooks.Open(fileName:=directory & fileName, _ UpdateLinks:=0, _ IgnoreReadOnlyRecommended:=True, _ Notify:=False, _ CorruptLoad:=xlNormalLoad) Call AllInternalPasswords 'this code is below wb.Close True i = i + 1 Application.StatusBar = "Files Completed: " & i fileName = Dir() Loop Application.AutomationSecurity = security Application.StatusBar = False Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Complete" End Sub Public Sub AllInternalPasswords() ' Breaks worksheet and workbook structure passwords. Bob McCormick ' probably originator of base code algorithm modified for coverage ' of workbook structure / windows passwords and for multiple passwords ' ' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1) ' Modified 2003-Apr-04 by JEM: All msgs to constants, and ' eliminate one Exit Sub (Version 1.1.1) ' Reveals hashed passwords NOT original passwords Application.DisplayAlerts = False 'Application.ScreenUpdating = False Const DBLSPACE As String = vbNewLine & vbNewLine Const AUTHORS As String = DBLSPACE & vbNewLine & _ "Adapted from Bob McCormick base code by" & _ "Norman Harker and JE McGimpsey" Const HEADER As String = "AllInternalPasswords User Message" Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04" Const REPBACK As String = DBLSPACE & "Please report failure " & _ "to the microsoft.public.excel.programming newsgroup." Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _ "now be free of all password protection, so make sure you:" & _ DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _ DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _ DBLSPACE & "Also, remember that the password was " & _ "put there for a reason. Don't stuff up crucial formulas " & _ "or data." & DBLSPACE & "Access and use of some data " & _ "may be an offense. If in doubt, don't." Const MSGNOPWORDS1 As String = "There were no passwords on " & _ "sheets, or workbook structure or windows." & AUTHORS & VERSION Const MSGNOPWORDS2 As String = "There was no protection to " & _ "workbook structure or windows." & DBLSPACE & _ "Proceeding to unprotect sheets." & AUTHORS & VERSION Const MSGTAKETIME As String = "After pressing OK button this " & _ "will take some time." & DBLSPACE & "Amount of time " & _ "depends on how many different passwords, the " & _ "passwords, and your computer's specification." & DBLSPACE & _ "Just be patient! Make me a coffee!" & AUTHORS & VERSION Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _ "Structure or Windows Password set." & DBLSPACE & _ "The password found was: " & DBLSPACE & "$$" & DBLSPACE & _ "Note it down for potential future use in other workbooks by " & _ "the same person who set this password." & DBLSPACE & _ "Now to check and clear other passwords." & AUTHORS & VERSION Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _ "password set." & DBLSPACE & "The password found was: " & _ DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _ "future use in other workbooks by same person who " & _ "set this password." & DBLSPACE & "Now to check and clear " & _ "other passwords." & AUTHORS & VERSION Const MSGONLYONE As String = "Only structure / windows " & _ "protected with the password that was just found." & _ ALLCLEAR & AUTHORS & VERSION & REPBACK Dim w1 As Worksheet, w2 As Worksheet Dim i As Integer, j As Integer, k As Integer, l As Integer Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer Dim PWord1 As String Dim ShTag As Boolean, WinTag As Boolean Application.ScreenUpdating = False With ActiveWorkbook WinTag = .ProtectStructure Or .ProtectWindows End With ShTag = False For Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents Next w1 If Not ShTag And Not WinTag Then 'MsgBox MSGNOPWORDS1, vbInformation, HEADER Exit Sub End If 'MsgBox MSGTAKETIME, vbInformation, HEADER If Not WinTag Then 'MsgBox MSGNOPWORDS2, vbInformation, HEADER Else On Error Resume Next Do 'dummy do loop For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 With ActiveWorkbook .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If .ProtectStructure = False And _ .ProtectWindows = False Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 'MsgBox Application.Substitute(MSGPWORDFOUND1, _ "$$", PWord1), vbInformation, HEADER Exit Do 'Bypass all for...nexts End If End With Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 End If If WinTag And Not ShTag Then 'MsgBox MSGONLYONE, vbInformation, HEADER Exit Sub End If On Error Resume Next For Each w1 In Worksheets 'Attempt clearance with PWord1 w1.Unprotect PWord1 Next w1 On Error GoTo 0 ShTag = False For Each w1 In Worksheets 'Checks for all clear ShTag triggered to 1 if not. ShTag = ShTag Or w1.ProtectContents Next w1 If ShTag Then For Each w1 In Worksheets With w1 If .ProtectContents Then On Error Resume Next Do 'Dummy do loop For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If Not .ProtectContents Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) 'MsgBox Application.Substitute(MSGPWORDFOUND2, _ "$$", PWord1), vbInformation, HEADER 'leverage finding Pword by trying on other sheets For Each w2 In Worksheets w2.Unprotect PWord1 Next w2 Exit Do 'Bypass all for...nexts End If Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 End If End With Next w1 End If 'MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER 'Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub