Opening Range from a different workbook - vba

I'm writing some VBA to check for changes to a spreadsheet when a button is clicked. The spreadsheet makes a copy of itself in the temp directory as determined by the environment variable on Workbook_Open(). This is all working fine, but the problem is with my button_click sub.
Following advice from this question, I'm trying to read the range of interest into an array. The problem is, my array is coming up empty. Is there something stupid that I'm forgetting to do here?
Dim wsOriginalWS As Worksheet
Dim varOriginalSheet As Variant
Dim wbkOrig As Workbook
Dim strRangeToCheck As String
Dim varOriginalSheet As Variant
'... some other non-relevant things
strRangeToCheck = "A5:HC231"
Set wbkOrig = Workbooks.Open(Filename:=FileStr)
Set wsOriginalWS = wbkOrig.Worksheets("Sheet1")
wsOriginalWS.Activate
With wsOriginalWS
Set varOriginalSheet = Range(strRangeToCheck)
End With
'... some other non-relevant things. At this point,
'... wbkOrig is still open, and I can see it with all of its data
'... while debugging.
itemp = getDimension(varOriginalSheet)
I have verified that everything up to Set varOriginalSheet = Range(strRangeToCheck) is working. The spreadsheet in the temp directory opens and is not empty. For some reason varOriginalSheet is empty.
Here's getDimensions:
Function getDimension(var As Variant) As Long
On Error GoTo Err
Dim i As Long
Dim tmp As Long
i = 0
Do While True
i = i + 1
tmp = UBound(var, i)
Loop
Err:
getDimension = i - 1
End Function

Related

excel vba to open a workbook by testing multiple passwords

I have password-protected .xls files in a directory. I would like to open each of these files and save them without the password.
However, the files can be opened by using either of the sample passwords listed below.
pwd1 = "123"
pwd2 = "456"
pwd3 = "789"
'Check if pwd1 opens
Application.Workbooks.Open(Filename:=fn, Password:=pwd1)
'If fail then use pwd2
Application.Workbooks.Open(Filename:=fn, Password:=pwd2)
'and so on..
How should I implement this?
Once the file has been opened once, you only need to Unprotect it. This will save a lot of time, instead of constantly opening/closing workbooks.
Here's how I'd do it:
Public Sub CrackWorkbook()
Dim fn As String
fn = "C:\Temp\test_password_is_456.xlsx"
Dim wb As Workbook
Set wb = Workbooks.Open(fn)
Dim lst As Variant
lst = Array("123", "456", "789")
Dim item As Variant
For Each item In lst
On Error GoTo did_not_work
Call wb.Unprotect(item)
Call wb.Save
Call wb.Close(False)
Exit Sub
did_not_work:
On Error GoTo 0
Next item
End Sub
In other words, create an array of strings and do a For Each on them, and set some error-handling to deal with all the failed attempts.
I know GoTo statements are a bit yucky, but that's the best way to handle errors in VBA (as far as I know).
I tried #lebelinoz answer however the routine gives a 1004 error. I googled this behavior and found this post:
https://stackoverflow.com/questions/21176638/vba-how-to-force-ignore-continue-past-1004-error
The code below works by using On Error Resume Next. I based this on #lebelinoz answer.
Public Sub CrackWorkbook()
Dim fn As String
fn = "C:\Temp\test_password_is_456.xlsx"
Dim wb As Workbook
Dim item As Variant
Dim lst As Variant
lst = Array("123", "456", "789")
For Each item In lst
On Error Resume Next
Workbooks.Open Filename:=fn, Password:=item
If Err.Number <> 0 Then GoTo did_not_work:
Exit For
did_not_work:
Next item
Set wb = Activeworkbook
wb.SaveAs Filename:=fn, Password:=""
wb.Close
End Sub

Open workbook if not already open, if already, then get that reference

Ive a scenario to do some changes in a workbook in another workbook path. But the question is I need to check whether the workbook already open or not. If not I need to get that opened instance to a workbook variable.
Here is the code Im using for checking whether workbook open or not and then the code for opening
Function IsFileOpen(fileFullName As String)
Dim FileNumber As Integer
Dim errorNum As Integer
On Error Resume Next
FileNumber = FreeFile() ' Assign a free file number.
' Attempt to open the file and lock it.
Open fileFullName For Input Lock Read As #FileNumber
Close FileNumber ' Close the file.
errorNum = Err ' Assign the Error Number which occured
On Error GoTo 0 ' Turn error checking on.
' Now Check and see which error occurred and based
' on that you can decide whether file is already
' open
Select Case errorNum
' No error occurred so ErroNum is Zero (0)
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied." is 70
' File is already opened by another user.
Case 70
IsFileOpen = True
' For any other Error occurred
Case Else
Error errorNum
End Select
End Function
Public Function getConsolidatedDataFile() As Workbook
Dim p As String
p = ActiveWorkbook.Path
Dim cf As String
cf = printf("{0}\ConsolidatedData.xlsx", p)
Dim wb As Workbook
Dim fo As Boolean
fo = IsFileOpen(cf)
If fo = False Then wb = Workbooks.Open(filename:=cf)
''I need to get the code for this place of fo is true
getConsolidatedDataFile wb
End Function
So if file open I need to get that workbook in to that wb variable.
Ive got a solution
If fo = False Then
Set wb = Workbooks.Open(filename:=cf)
Else
Dim w As Workbook
For Each w In Workbooks
If w.FullName = cf Then
Set wb = w
End If
Next
End If
Here is in the loop its traversing through all workbook and if its there take that reference..
I hope this help
Dim dict As Dictionary
Function OpenFile(fileFullName As String) As Workbook
If (dict.Exists(fileFullName)) Then
OpenFile = dict.Item(fileFullName)
End If
dict.Add "fileFullName", Workbooks.Open(Filename:=fileFullName)
OpenFile = dict.Item(fileFullName)
End Function
Application.ActiveWorkbook = OpenFile(fileFullName)
To reference a workbook to the workbook collection it should be opened -
The Workbook object is a member of the Workbooks collection. The Workbooks collection contains all the Workbook objects currently open in Microsoft Excel.
MSDN Wrokbook Object
Thus, if your workbook is in the same Excel instance, then try like this:
Public Sub TestMe()
Dim wb As Workbook
Set wb = Workbooks("12.xlsx")
End Sub
If it is not in the same instance, then GetObject should work:
Public Sub TestMe()
Dim wb As Workbook
Set wb = GetObject("C:\path\12.xlsx")
Debug.Print wb.Worksheets(1).Name
End Sub
GetObject MSDN
This is how 3 workbooks in the same instance look like:
This is how 2 workbooks look like in 2 different instances:
Pros and Cons for using multiple instances (Source answers.microsoft.com):
Pros
If you have 32-bit Excel, each instance can use up to 3 GB memory. If you have a powerful computer, very heavy files, and 32-bit Excel, each instance of Excel can use 3 GB. So with e.g. 2 instances of Excel.exe, you could say that the total memory Excel could use triples. (Please note that this is not needed with 64-bit Excel as it is not limited by 3 GB memory per instance)
If you want to have a separate Undo chain, so that each Undo only undos in the currently active workbook, then separate instances will indeed achieve this.
Cons
If you want to have a common Undo chain shared by all open files, then using multiple instances will not achieve this.
If you want to be able to e.g. press Ctrl+F6 to jump between your open files quickly, then using multiple instances will not achieve this.
Paste Special will not work between instances. See this for more info.
Making workbook links between 2 files in separate running instances cannot be made by clicking, and will not update in real-time.
The code looks ok, simply use the Set keyword:
If fo = False Then set wb = Workbooks.Open(filename:=cf)
Here is a quick function that will open the workbook if it's not already open:
Function GetWorkBook(ByVal sFullName As String, Optional ReadOnly As Boolean) As Workbook
Dim sFile As String: sFile = Dir(sFullName)
On Error Resume Next
Set GetWorkBook = Workbooks(sFile)
If GetWorkBook Is Nothing Then Set GetWorkBook = Workbooks.Open(sFullName, ReadOnly:=ReadOnly)
On Error GoTo 0
End Function

VBA .ChangeLink issue

I am facing a very weird problem with VBA code. I have an excel file which uses UDFs from an Addin. This file runs on the server so it is really impossible for me to see what actually is going on in the code. Now, whenever I make any changes in the file (on my local machine), I use the local version of the addin. So when replacing the file on the server, I need it to automatically change the links to the addin copy that is there on the server. For this purpose, I have this piece of code in the file:
Private Sub changeLinks(addinName As String, wb As Workbook)
Dim check As Long
Dim i As Long
Dim existingPath As String
Dim correctPath As String
Dim temp As Variant
Dim tempA As Variant
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.ScreenUpdating = False
temp = getLinks(addinName, wb)
On Error Resume Next
correctPath = Application.AddIns(addinName).fullName
For i = 1 To 100
If temp(i) = "" Then Exit For
If UCase(temp(i)) <> UCase(correctPath) Then
wb.ChangeLink temp(i), correctPath, xlLinkTypeExcelLinks
End If
Next
On Error GoTo 0
End Sub
Private Function getLinks(addinName As String, wb As Workbook)
Dim allLinks As Variant
Dim check As Long
Dim i As Long
Dim temp(1 To 100) As Variant
Dim linkCounts As Long
check = 0
allLinks = wb.LinkSources
linkCounts = 0
On Error Resume Next
For i = LBound(allLinks) To UBound(allLinks)
check = InStr(1, UCase(allLinks(i)), UCase(addinName))
If check <> 0 Then
linkCounts = linkCounts + 1
temp(linkCounts) = allLinks(i)
End If
Next
On Error GoTo 0
getLinks = temp
End Function
In spite of all the statements like Application.DisplayAlerts=False and On Error Resume Next, the code hangs on the line where I use .ChangeLink method. Curiously, the code works ok if I login to the server and run this manually. I believe it is due to some pop-up which appears when the code tries to run .ChangeLink statement. I can't see what this pop-up is, because it runs on the server with a different login. And so now I'm just banging my head to the wall.
Appreciate any help.

Range.Formula error with user defined functions

Hello guy I have a user defined function inside VBA
Function clean(word As String, ParamArray characters() As Variant) As String
For i = 0 To UBound(characters)
word = Replace(word, characters(i), "")
Next i
clean = word
End Function
whenever I try to use it in another subroutine like that
Sub prova()
Dim wb As Workbook
Dim wsB As Worksheet
Set wb = ThisWorkbook
Set wsB = wb.Sheets("Bond Holdings")
wsB.Range("R3").Formula = "=clean(""dfsduuu"",""u"")"
End Sub
I get runtime error 1004. Could you guys help me figure out why? this is driving me crazy.
Thank you
Excel has a built-in function called CLEAN. You have a name-clash. If you call your function e.g. cleaner, it will work as expected.

Setting value of named range in Excel

I apologize if this is a total noob question. I'm in the process of writing an addin for Excel. I have a sub inside class1 that opens an excel file, in this sub I have a reference to sub2 which is below. All I am looking to do is hook into the active instance of Excel, change a named range value and exit. But I keep getting errors no matter which way that I try. Here is what I have. Tell me where I have gone wrong. Forgot to mention, this is in VB.NET.
Private Sub SetRangeValue(ByVal RangeName As String, ByVal RangeValue As String)
Dim ExcelApp As Excel.Application
Dim TheRange As Excel.Range
Dim TheRangeName As String = ""
'Hook into running excel instance
ExcelApp = CType(Marshal.GetActiveObject("Excel.Application"), Excel.Application)
'First Attempt Here
TheRange = ExcelApp.ActiveWorkbook.Names.Item(RangeName)
TheRange.Value = RangeValue
'Second Attempt
TheRange = ExcelApp.Range(RangeName)
TheRange.Value = RangeValue
End Sub
I can't get either one to work. Any help is appreciated.
Finally I got this to work properly. This is how it needed to work. Thanks for all the help.
Private Sub SetRangeValue(ByVal RangeName As String, ByVal RangeValue As String)
Dim ExcelApp As Excel.Application
'Dim TheRangeObj As Excel.Range
Dim TheRange As Microsoft.Office.Interop.Excel.Name
Dim TheRangeName As String = ""
'Hook into running excel instance
ExcelApp = CType(Marshal.GetActiveObject("Excel.Application"), Excel.Application)
TheRange = ExcelApp.ActiveWorkbook.Names.Item(RangeName)
TheRange.RefersToRange.Value = RangeValue
End Sub
'First Attempt Here
TheRange = ExcelApp.ActiveWorkbook.Names.Item(RangeName)
TheRange.Value = RangeValue
According to Names.Item Method (Excel), this function returns a single Name object from a Names collection. In this case TheRange is not valid name for this variable, it should be TheName. Then
TheName.Value = RangeValue
is not right assignment; According to Name.Value Property (Excel) this property - Returns or sets a String value that represents the formula that the name is defined to refer to.
Error 0x800A03EC, there are a number of reasons this error is returned from Excel - the most common is when attempts to write data larger than Excel can handle. For example, you try to write a string longer than 1024 characters to a cell in Excel
I just made a sub that would make it easier me to find & replace using my named ranges:
Private Sub XlFindReplace(ByRef xSheet As Excel.Worksheet, ByVal cellName As String, ByVal NewText As String)
xSheet.Range(cellName).Value = NewText
End Sub
then T'd call it like this in order to replace stuff:
XlFindReplace(xlC1Sheet, "client1Co1Tax", client1Co1Tax)
where the xlC1Sheet is the sheet I'm currently
the "client1Co1Tax"is the name of the range in excel
and client1Co1Tax is the string variable I'm replacing it
Thanks to everyone for their input.