Re-Initializing "ThisWorkbook.Path" - file

First, thanks to those of you who gave me the suggestion on using "ThisWorkbook.Path". It worked like a charm.
However, my code walks through seven (7) workbooks and when using "ThisWorkbook.Path" I can not re-initialize the "This.Workbook". Let me elaborate.
This is the workbook where the Macro resides:
Workbooks("Financial_Aggregator_v3.xls").Activate
This is the first workbook where the code adds a tab and does sub-totals. Basically, ThisWorkbook.Path works here:
Workbooks("Chapter_7-10_Mechanical.xls").Activate
After doing what I need done with "Mechanical" I have the following code snippet, which never turns out TRUE:
Workbooks("Financial_Aggregator_v3.xls").Activate
If FileThere(ThisWorkbook.Path & Application.PathSeparator & "Chapter_7-90_ECS_1_LLC.xls") Then
The code for the function, which works for the "Mechanical" sheet is:
Function FileThere(FileName As String) As Boolean
FileThere = (Dir(FileName) > "")
End Function
FYI, I tried to break all of the different Workbooks into different Sub(), but that didn't work. I also triple-checked the name of the workbooks.
Thanks in advance.

"ThisWorkbook" in Excel.VBA is sort of like "Me", in that it only applies to the workbook (.XLS) that actually holds the VBA code that is executing the "ThisWorkbook". What you need to do is to use Workbook objects to abstract the particular workbook that you want to test or manipulate.
Try something like this:
Public Sub TestWB()
Dim CurrWB As Workbook
'To get a workbook into our object variable:'
Set CurrWB = Workbooks("Chapter_7-10_Mechanical.xls")
'To Change the .Path:'
CurrWB.SaveAs NewFileName, AddToMru:=True
End Sub

Related

Can't copy a value from one worksheet over to an array in another worksheet

In the same workbook, I've got two worksheets: Model and Results.
My goal is to copy the value of a cell in Model (for e.g., F8) over to a cell in an array (c4 to I23) in Results called ResultsArray (see code below).
When I run my module, no error appears, but the code doesnt seem to work either (the value of F8 doesnt get copied over to the specified cell in ResultsArray).
Appreciate any help.
Tried running different variations of the code below
Sub CopyTest()
Dim ResultsArray As Variant
ResultsArray = Worksheets("Results").Range("C4:I23")
ResultsArray(1, 1) = Worksheets("Model").Range("F8").Value
End Sub
I'm using ResultsArray(1,1) because I am hoping to introduce a loop into the code to populate cells in the array based on the loop counter, e.g., ResultsArray(loopcounter,1)
So turns out I just needed to add "Set" in the 2nd line before "ResultsArray" when assigning the range from the worksheet "Model" to it:
Sub CopyTest()
Dim ResultsArray As Variant
Set ResultsArray = Worksheets("Results").Range("C4:I23")
ResultsArray(1, 1) = Worksheets("Model").Range("F8").Value
End Sub
I've tested this addition and it works

How to copy corresponding cell values from another workbook?

I want to copy cells of a certain colour in "Hacked" workbook to the "Official" workbook. I also want to loop across multiple sheets. Right now I am only testing on one sheet and the loop is already getting stuck.
Sub CopyBasel2()
Dim Hacked As Workbook
Set Hacked = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G (Password Breaker).xls")
Dim Official As Workbook
Set Official = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G.xls")
Dim Cell As Range
For Each Cell In Hacked.Sheets("SA-CR.1(CE)").UsedRange.Cells
If Cell.Interior.Color = 13434828 Then
Official.Sheets("SA-CR.1(CE)").Range(Cell.Address).Value = Cell.Value
End If
Next Cell
Debug.Print Hacked.Sheets("SA-CR.1(CE)").Range("C10").Interior.Color
End Sub
Thanks everyone for your guidance, I have managed to get my code to work as below, complete with a loop through an array of sheets.
The reason my earlier code couldn't work was because I was opening the "Official" file at the same time. When I closed it and ran my code, it ran smoothly. Anyone know the logic behind this?
Also, if anyone has a better/more elegant way of doing the array and the loops part, please feel free to share it.
Sub CopyBasel2()
Dim Hacked As Workbook
Set Hacked = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G (Password Breaker).xls")
Dim Official As Workbook
Set Official = Workbooks.Open("H:\BASEL Reporting - Oliver's Mock\Report Submission\BASEL2_0262CRT30062021G.xls")
With Hacked
Set WSArray = .Sheets(Array("SA-CR.1(CE)", "SA-CR.2(CRM.1)", "SA-CR.3(CRM.2)", "SA-CR.4(RWA)", _
"SA-CR.6(OBS)", "SA-CR.6.1(CD)", "SA-CR.7(Recon)"))
End With
For Each ws In WSArray
For Each Cell In Hacked.Sheets(ws.Name).UsedRange
If Cell.Interior.Color = 13434828 Then
Official.Sheets(ws.Name).Range(Cell.Address).Value = Cell.Value
End If
Next Cell
Next ws
End Sub

Create reference table or array inside of the code

I am trying to create a function that allows me to put in a location number and the result will give me a unique location code. The problem is I want all of the referencing done inside of the macro code, not to get the information from somewhere in the spreadsheet. (this code is going into an add-in so there is no worksheet to reference from). I basically want to do a vlookup but inside of the code, not in a worksheet.
I haven't been able to find out how to do this, the code below is something like what I am looking for, I am thinking maybe the use of an array but I can't figure out how to use it the way I want.
I know this doesn't work but I am trying to do something like this below so that when I type in =GetCode(415) the result is 001
Function GetCode(LocationNum As String) As String
Dim Result As String
'Built in reference table
'
'{ "415" : "001"
' "500" : "002"
' "605" : "003"
' }
Dim varData(2) As Variant
varData("415") = "001"
varData("500") = "002"
varData("605") = "003"
Result = varData(LocationNum)
GetCode = Result
End Function
As Nathan_Sav has already mentioned, you can use a collection or dictionary instead, which are much more efficient. Here's an example using the dictionary object. Note that it uses early binding, so you'll need to set a reference to the Microsoft Scripting Runtime library (Visual Basic Editor >> Tools >> Reference).
Option Explicit
Sub test()
'set a reference (VBE >> Tools >> Reference) to the Microsoft Scripting Runtime library
'declare and create an instance of the dictionary object
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
'set the comparison mode for the dictionary to a case-insensitive match
dic.CompareMode = TextCompare
'add keys and associated items to the dictionary
dic.Add Key:="415", Item:="001"
dic.Add Key:="500", Item:="002"
dic.Add Key:="605", Item:="003"
'print to the immediate window the item associated with the specified key
Debug.Print dic("415")
'clear from memory
Set dic = Nothing
End Sub

How to obtain 2 dimensional arrays of Single in VB.NET exactly like in VBA?

I have some code written in VBA that uses a function of the particular environment I programmed in, which given some empty, not fixed-dimensional Single arrays, gives them back 2 dimensional and filled with data. It also produces a Variant as output.
The VBA code is:
Dim vDummy As Variant
Dim RealLev1() As Single, ImagLev1() As Single
vDummy = FFPOL1Array(RealLev1, ImagLev1)
Now, I know for sure that FFPOL1Arrayis a routine written in FORTRAN, but I cannot access to its code by any means.
I successfully managed to address the same routine in a VB.NET piece of code by writing a workaround that "links" my code to the environment mentioned above and uses its own scripting routines.
My VB.NET code would be:
Dim vDummy As Object
Dim RealLev1(,) As Single, ImagLev1(,) As Single
vDummy = NSI.FFPOL1Array(RealLev1, ImagLev1)
NSI is the "scripting routines object", which is working with many other functions and subroutines.
Sadly the code above does not work because (according to the debugger) of a type conflict. So I checked the Classes-Explorer and found out that the FFPol1Array class is defined as:
get_FFPOL1Array(ByRef System.Array, ByRef System.Array) As Object
set_FFPOL1Array(ByRef System.Array, ByRef System.Array, ByRef Object)
Thus I tried to Dim my arrays as System.Array instad of Single but this failed too always because of a type conflict. What am I doing wrong?
OK this was a little ridiculous but I managed to understand that I eventually had to initialize the Arrays, because the FORTRAN function did not do that:
Dim RealLev1 As Array = Array.CreateInstance(GetType(Single), 1, 1)
Dim ImagLev1 As Array = Array.CreateInstance(GetType(Single), 1, 1)
This did the job. Even better was:
Dim RealLev1(,) As Single = Array.CreateInstance(GetType(Single), 1, 1)
Dim ImagLev1(,) As Single = Array.CreateInstance(GetType(Single), 1, 1)
As #Nathan_Sav suggested, get_FFPOL1Array is returning an Object so you need to use Set.
Set vDummy = NSI.FFPOL1Array(RealLev1, ImagLev1)

How to fill-up cells within a Excel worksheet from a VBA function?

I simply want to fill-up cells in my spreadsheet from a VBA function. By example, I would like to type =FillHere() in a cell, and in result I will have a few cells filled-up with some data.
I tried with such a function:
Function FillHere()
Dim rngCaller As Range
Set rngCaller = Application.Caller
rngCaller.Cells(1, 1) = "HELLO"
rngCaller.Cells(1, 2) = "WORLD"
End Function
It breaks as soon as I try to modify the range. Then I tried this (even it's not really the behavior I'm looking for):
Function FillHere()
Dim rngCaller As Range
Cells(1, 1) = "HELLO"
Cells(1, 2) = "WORLD"
End Function
This is not working neither. But it works if I start this function from VBA using F5! It seems it's not possible to modify anything on the spreadsheet while calling a function... some libraries do that though...
I also tried (in fact it was my first idea) to return a array from the function. The problem is that I only get the first element in the array (there is a trick that implies to select a whole area with the formula at the top left corner + F2 + CTRL-SHIFT-ENTER, but that means the user needs to know by advance the size of the array).
I'm really stuck with this problem. I'm not the final end-user so I need something very easy to use, with, preferably, no argument at all.
PS: I'm sorry I asked this question already, but I wasn't registered at that time and it seems that I can't participate to the other thread anymore.
You will need to do this in two steps:
Change your module to be something like:
Dim lastCall As Variant
Dim lastOutput() As Variant
Function FillHere()
Dim outputArray() As Variant
ReDim outputArray(1 To 1, 1 To 2)
outputArray(1, 1) = "HELLO"
outputArray(1, 2) = "WORLD"
lastOutput = outputArray
Set lastCall = Application.Caller
FillHere = outputArray(1, 1)
End Function
Public Sub WriteBack()
If IsEmpty(lastCall) Then Exit Sub
If lastCall Is Nothing Then Exit Sub
For i = 1 To UBound(lastOutput, 1)
For j = 1 To UBound(lastOutput, 2)
If (i <> 1 Or j <> 1) Then
lastCall.Cells(i, j).Value = lastOutput(i, j)
End If
Next
Next
Set lastCall = Nothing
End Sub
Then in order to call the Sub go into the ThisWorkbook area in VBA and add something like:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call WriteBack
End Sub
What this does is return the value of the topleft cell and then after calculation completes populates the rest. The way I wrote this it assumes only one FillHere function will be called at a time. If you want to have multiple ones which recalculate at the same time then you will need a more complicated set of global variables.
One word of warning is that this will not care what it overwrites when it populates the other cells.
Edit:
If you want to do this on a Application wide basis in an XLA. The code for the ThisWorkbook area should be something like:
Private WithEvents App As Application
Private Sub App_SheetCalculate(ByVal Sh As Object)
Call WriteBack
End Sub
Private Sub Workbook_Open()
Set App = Application
End Sub
This will wire up the Application Level calculation.
What you're trying to do won't work in Excel - this is by design.
You can do this, though:
Function FillHere()
Redim outputArray(1 To 1, 1 To 2)
outputArray(1, 1) = "HELLO"
outputArray(1, 2) = "WORLD"
FillHere = outputArray
End Function
If you then select two adjacent cells in your worksheet, enter =FillHere() and press Control+Shift+Enter (to apply as an array formula) then you should see your desired output.
Fundamentally, a function can only affect the cell it is called from. It sounds like you may need to look at using the Worksheet_Change or Worksheet_SelectionChange events to trigger the modification of cells in the intended range.
You can do this indirectly using a 2-stage process:
Write your UDF so that it stores data in a sufficiently persistent way (for example global arrrays).
then have an Addin that contains application events that fire after each calculation event, looks at any data stored by the UDFs and then rewrites the neccessary cells (with warning messages about overwrite if appropriate) and reset the stored data.
This way the user does not need to have any code in their workbook.
I think (but do not know for sure) that this is the technique used by Bloomberg etc.

Resources