VBA - Get Cell Values from other workbook without opening - vba

I'm working to get the cell value of other workbook without opening it.
And here's some of my codes:
Range("F3")= "='C:\inetpub\vhosts\hotdogko.com\httpdocs\private\excel\[Launch Pad.xls]Sheet1'!$B$12 "
This code is working well when data type of the cell value to pull is Date, Integer or Any not String data type. But it wont work correctly to string data type, it just returning #N/A.
Thanks for someone who can give me an answer for this problem.

You can try with following answer
Sub ReadDataFromAnotherWorkBook()
' Open Workbook A with specific location
Dim src As Workbook
Set src = Workbooks.Open("C:\Users\chan.yoonghon\Desktop\Excel\BookA.xlsx", True, True)
Dim valueBookA As Integer
Dim valueBookB As Integer
valueBookA = src.Worksheets("sheet1").Cells(1, 1)
Cells(1, 1).Value = valueBookA
' Close Workbooks A
src.Close False
Set src = Nothing
' Dialog Answer
MsgBox valueBookA
End Sub

If you add the text function after the equal It should work something like:
Range("F3")= "=text("'C:\inetpub\vhosts\hotdogko.com\httpdocs\private\excel\[Launch Pad.xls]Sheet1'!$B$12 " ;"") "
Perhaps you should check if the " are correct because sometimes you have to add double "".

Try it without using quotation marks (" "). It should help.

Related

Excel 2016 VBA - Compare 2 PivotTables fields for matching values

Hi please can someone help, Excel 2016 VBA PivotTable objects. I rarely develop in Excel VBA.
Overall goal:
Compare a single column [P_ID] value list from PivotTable2 against PivotTable1 if they exist or not to enable filtering on those valid values in PivotTable1.
I have some Excel 2016 VBA code which I have adapted from a previous answer from a different internet source.
Logic is: gather data from PivotTable2 from the ComparisonTable dataset (in PowerPivot model), field [P_ID] list of values. Generate a test line as input into function to test for existence of field and value in PivotTable1 against the Mastertable dataset, if true add the line as valid if not skip the line.
Finally filter PivotTable1 with the VALID P_ID values.
It works to a point until it gets to the bFieldItemExists function which generates an error:
Run-time error '1004'
Unable to get the PivotItems property of the PivotField class
Can someone please correct the way of this not working?
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim MyArray As Variant, _
ar As Variant, _
x As String, _
y As String, _
str As Variant
MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange
For Each ar In MyArray
x = "[MasterTable].[P_ID].&[" & ar & "]"
If ar <> "" And bFieldItemExists(x) = True Then
If str = "" Then
str = "[MasterTable].[P_ID].&[" & ar & "]"
Else
str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
End If
End If
Next ar
Dim str2() As String
str2 = Split(str, ",")
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function bFieldItemExists(strName As String) As Boolean
Dim strTemp As Variant
' This line does not work!?
strTemp = ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").PivotItems(strName)
If Err = 0 Then bFieldItemExists = True Else bFieldItemExists = False
End Function
The 1004 error occurred due to the use of square brackets [ ]. Remove those.
You also need to use the key word Set when you set an object equal to something. For example Set MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.[P_ID").DataRange.
If you don't use Set you will get a VBA run-time error dialog that says Run-time error '91': Object variable or With block variable not set
I cannot guarantee that my edits will completely solve your problem since I don't have your data set and cannot fully test your code. You will need to use the Debug mode in the VBA editor and single step through the code. To this set a breakpoint on the Set mDataRange = Active.... To set a breakpoint go to the Debug menu and choose the "Toggle Breakpoint" sub-menu item or you can press F9 to set the breakpoint.
Now when you make a change to the Pivot table, the Worksheet_PivotTableUpdate event will fire and the code will top execution at that point.
After the code stops executing due to the breakpoint, you can press the F8 key to single step through your code. If you want to resume execution to the next breakpoint you can press F5. Also when you get the VBA error dialog box, you can hit Debug and then use the F8 key to single step or use the debug windows to see what your variables and objects contain. I'm sure there are some good youtube videos on VBA debugging.
As you single step through the code, you can observe what each variable/object contains using the Immediate window, the Watches window and the Locals window. To open these windows, go to the menu item View and click on each of these sub-menu items.
Here's how you need to edit your code before debugging.
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'Better practice is to not use the underscore character to
'continue a Dim declaration line
Dim mDataRange As Range
Dim ar As Range
Dim x As String
Dim y As String
Dim str As Variant
'Use Set to assign the object mDataRange a reference to the the right
'hand side of the equation. Remove the square brackets
'MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange
Set mDataRange = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.P_ID").DataRange
For Each ar In mDataRange
'You need to specify what proprerty from ar you
'want to assign to x. Assuming the value stored in
'ar.Value2 is a string, this should work.
'We use value2 because it is the unformmated value
'and is slightly quicker to access than the Text or Value
'properties
'x = "[MasterTable].[P_ID].&[" & ar & "]"
x = "MasterTable.P_ID." & ar.Value2
'Once again specify the Value2 property as containing
'what value you want to test
If ar.Value2 <> "" And bFieldItemExists(x) = True Then
If str = "" Then
'Remove the square brackets and use the specific property
'str = "[MasterTable].[P_ID].&[" & ar & "]"
str = "MasterTable.P_ID." & ar.Value2
Else
'Remove the square brackets and use the specific property
'str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
str = str & "," & "MasterTable.P_ID." & ar.Value2
End If
End If
Next ar
Dim str2() As String
str2 = Split(str, ",")
Application.EnableEvents = False
Application.ScreenUpdating = False
'Remove square brackets
'ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)
ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").VisibleItemsList = Array(str2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function bFieldItemExists(strName As String) As Boolean
'Declare a PivotItem to accept the return value
Dim pvItem As PivotItem
'Since you want to trap for an error, you'll need to let the VBA runtime know
'The following code is a pseudo Try/Catch. This tells the VBA runtime to skip
'the fact an error occured and continue on to the next statement.
'Your next statement should deal with the error condition
On Error Resume Next
'Use Set whenever assigning an object it's "value" or reference in reality
Set pvItem = ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").PivotItems(strName)
'Assuming that an error gets thrown when strName is not found in the pivot
'Err is the error object. You should access the property you wish to test
If Err.Number = 0 Then
bFieldItemExists = True
Else
bFieldItemExists = False
End If
'Return to normal error functioning
On Error GoTo 0
End Function
Finally, I realize that some of this should be in the comments section, but there was too much I needed to explain to help Learner74. BUT most importantly, I hope I helped him. I have used so many suggestions, recommendations and explanations from the VBA Stack Overflow exchange through the years, I just want to pay it back by paying it forward.
Additional USEFUL Links:
Chip Pearson is the go to site and person for all things VBA
Paul Kelly's Excel Macro Mastery is another go to site for Excel and VBA questions.
Microsoft Excel Object Model which is sometimes useful, but needs improvement. Too many of the objects lack examples, but can at least point you in the right direction.

Add Quotation Marks Within Specific Region of a String

I am attempting to format a string within my VBA code that will add quotation marks within a specific region of said string, in this case just the date, so another code block can either loop through the data or do a vlookup for a specific string that matches a keyword. I will give an example below.
Variable string: appointmentArrivalTime:"2018-08-26 01:00:00.000000"
Keyword/string: "2018-08-24 01:00:00.000000"
The date will constantly change based on the current date, so the above is just an example.
Example code:
Dim Main As Worksheet
Set Main = Worksheets("Main")
Dim ISA_List As Worksheet
Set ISA_List = Worksheets("ISA_List")
Dim ISA_Results As Worksheet
Set ISA_Results = Worksheets("ISA_Results")
Dim Oculus_Raw As Worksheet
Set Oculus_Raw = Worksheets("Oculus_Raw")
Dim ContainWord As String
Dim CWDate As String
CWDate = Worksheets("Main").Range("Date")
ContainWord = "appointmentArrivalTime:" & Format(CWDate, "YYYY-MM-DD")
What I need is for VBA/Excel to look at a cell named "Date" which contains the current date, format the string so it contains "appointmentArrivalTime" and the current date, which in this case is "CWDate" and then add quotation marks as follows.
appointmentArrivalTime:"2018-08-24"
Currently my code only gives me the following:
"appointmentArrivalTime:2018-08-24"
Hopefully what I am asking makes sense. Any help is appreciated.
Thank you.
This works for me:
MsgBox "appointmentArrivalTime:" & Chr(34) & Format(CDate(CWDate), "YYYY-MM-DD") & Chr(34)
My message box output:
Hope it helps!

Filename in variable used for formulas and copying

I am trying to use a wildcard filename as a variable so I can use it to copy and do some formulas. And then I want to flatten all the formulas.
It looks like this:
This first part works (first thing opens wildcard file from a cell formula and second assigns only filename without path to variable Prod - hovering over variable prod gives exactly what it should)
Dim wbProd As Workbook
Windows("SB.xlsm").Activate
Set wbProd = Workbooks.Open(FileNAME:=Sheets("refs").Range("B48").Value)
Dim Prod As String
Windows("SB.xlsm").Activate
Prod = Worksheets("refs").Range("B49").Value
Windows("Weekly.xlsx").Activate
With Workbooks(" & Prod & ").Sheets("Report 1")
.Range("A2:BG10", .Range("A2:BG10").End(xlDown)).Copy Workbooks("WeeklyData X.xlsx").ActiveSheet.Range("A2")
End With
Windows("WeeklyData X.xlsx").Activate
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Report 1")
ws.UsedRange.Value = ws.UsedRange.Value
I am getting an error with this first part of copying: With Workbooks(" & Prod & ").Sheets("Report 1"). When I use this copying method without using filename in a variable it works and also when I use variable filename to do Vlookups it works. I dont know what would be the reason not to work here.
Also if you have better way to flatten all the formulas and preseve formats (coz of dates) it would be great.
Thanks,
A quick fix would be to create a Workbook variable (Dim myWB as Workbook),
Then do Set myWB = Workbooks(Prod). Then just do With myWB.Sheets("Sheet1").
The issue is that Excel needs quotes in the sheet name, and so your book is literally being understood as being titled & Prod &. So, to keep your current idea, you need to just add an additional quote to each quote: With Workbooks("" & Prod & "").Sheets("Report 1").
Personally I recommend setting up a workbook variable, but either works!
Edit:
#drLecter - Very welcome! You'll also run into the "double quotes" issue when trying to set up formulas that have quotes in them. IE The worksheet formula =Vlookup("myText",A1:D1,2,False) would, in VBA, become
Cells(1,1).Formula = "=Vlookup(""myText"",A1:D1,2,False)".
As you can see, if I didn't use double quotes, VBA would stop reading the formula at
Cells(1,1).Formula = "=Vlookup(
Use dir() !
Microsoft Documentation link - dir() function
-Returns a string representing the name of a file, directory, or folder that matches a specified pattern or file attribute, or the volume label of a drive.
just adapt something like this::
Sub LoopThroughFiles()
Dim MyObj As Object, MySource As Object, file As Variant
file = Dir("c:\testfolder\")
While (file <> "")
If InStr(file, "test") > 0 Then
MsgBox "found " & file
Exit Sub
End If
file = Dir
Wend
End Sub

Adding values to a combobox based on another value VBA

I am currently trying to get a combobox to add items based on another combobox value, but am coming unstuck.
The following is the code I have so far - through trial and error I have got to this stage, although this is still giving me a "1004" error relating to the last line of the code. Is there a better way of writing this to get the same result?
Private Sub ProductInfo1_Change()
Dim strName As String
Dim strNameProductAllData As String
Dim strNameProductName As String
Dim strNameProductDescription As String
strName = Replace(OrderForm1.OrderFrm3.Value, " ", "")
sheet = "strName"
strNameProductName = Replace(strName, " ", "") & "productname"
strNameProductDescription = Replace(strName, " ", "") & "productdescription"
Me.ProductInfo2 = Application.WorksheetFunction.Index(Sheets(strName).Range(strNameProductDescription), Application.WorksheetFunction.Match(ProductInfo1.Value, Sheets(strName).Range(strNameProductName), 0))
End Sub
You are assigning to the wrong object.
You are trying to set a combobox, ProductInfo equal to a range.
What you want to do is use the "RowSource" property of the combobox
For example:
Me.ProductInfo2.RowSource = "mySheet!$A$1:$A$10"
This would make the choices for the ProductInfo2 combobox the items in cells A1-A10.
It is unclear what you are trying to get with the Match/Index Worksheet functions. If the contents of the cell have a range, then just use the contents to be equal to this rowsource. So for instance, if the column that represents "strNameProductDescription" has the range "myRange" in it, then your code can simply be modified to put this into the RowSource property. If it contains some other piece of information, then you need to construct the range you are looking for so that it would be similar to the line shown above. If myRange is a range on your worksheet, then the code,
Me.ProductInfo2.RowSource = "myRange"
will work.

Write a VLOOKUP as a string in a cell with dynamic path retrieved through GetoOpenfilename

I am trying to write a VLOOKUP in a cell as a string, with VBA. This means that I do not want the result to appear in the cell as a value, but I want the whole VLOOKUP expression instead (For this example : "VLOOKUP(C6,'[path_to_file.xlsm]OTD Table!$B:$F,4,0)"). The challenge is that the range argument of the VLOOKUP is a concatenation of a path (path_to_file.xlsm) that the user selects with a GetOpenFilename, and a string that specifies the tab in which the lookup table is located ("OTD Table!$B:$F,4,0").
The issue I am getting is very interesting :
When I print my expression in a Msgbox, the expression appears correctly. However, when I write it in a cell, the path mysteriously appears incorrectly.
Sub macro()
dim data_file_new as String
data_file_new = CStr(Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Select new data file")) ' The user selects the file
str_ = "=VLOOKUP(C6," & "'[" & data_file_new & "]OTD Table!$B:$F,4,0)" ' This will display the expression correctly
cells(1,10)="=VLOOKUP(C6," & "'[" & data_file_new & "]OTD Table!$B:$F,4,0)"' This will not display the same thing as in the messagebox above
end Sub
I hope one of you guys can make sens of this !
Because you're dropping a formula into a cell that you want to display as straight text, you have to be explicit with Excel and tag the text string to prevent interpreting it as a formula. The simplest way to do this is pre-pend the string with a single-quote "'".
Sub macro()
Dim data_file_new, str_ As String
str_ = "'=VLOOKUP(C6,'["
data_file_new = CStr(Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Select new data file")) ' The user selects the file
str_ = str_ & data_file_new & "]OTD Table!$B:$F,4,0)" ' This will display the expression correctly
ActiveSheet.Cells(1, 10).Value = str_
End Sub
Yeah either you'll need to set the string to add a single quote, or you'll need to change the numberformat of the cell to text (Cells(1,10).NumberFormat = "#")
Either of those should work.