Trying to vlookup from another workbook(its name I search in a certain folder upfront). I got error message Unable to get Vlookup property of the WorksheetFunction class.
I added watches to see if I have meaningful variables.
Tried to put Thisworkbook. in front of sh_main but it does't work either. I don't know what do I do wrongly, any help highly appreciated!
Sub Actual_inventory()
Assignments1
Dim directory As String, fileName As String, i As Integer
Dim col_unrestricted As String
Dim range_temp2 As Range
Application.ScreenUpdating = False
directory = "C:\Users\marcellh\Documents\Reports\Actual\"
fileName = Dir(directory & "*.xl??")
Workbooks.Open (directory & fileName)
'converts column A to number format:
Range("A:A").Select
With Selection
.NumberFormat = "General"
.Value = .Value
End With
'searches column "unrestricted":
Set range_temp2 = Workbooks(fileName).Sheets(1).Cells.Find("unrestricted")
col_unrestricted = range_temp2.Column
'---
i = first_data_set
Do While sh_main.Cells(i, col_color).Value <> ""
'vlookups based on old gmid, iferror then "":
sh_main.Cells(i, col_inventory_old_gmid).Value = Application.WorksheetFunction.VLookup(sh_main.Cells(i, col_old_gmid_code).Value, Workbooks(fileName).Sheets(1).Range("A:L"), col_unrestricted, False)
If IsError(sh_main.Cells(i, col_inventory_old_gmid).Value) Then
sh_main.Cells(i, col_inventory_old_gmid).Value = ""
End If
'vlookups based on new gmid, iferror then "":
sh_main.Cells(i, col_inventory_new_gmid).Value = Application.WorksheetFunction.VLookup(sh_main.Cells(i, col_new_gmid_code).Value, Workbooks(fileName).Sheets(1).Range("A:L"), col_unrestricted, False)
If IsError(sh_main.Cells(i, col_inventory_new_gmid).Value) Then
sh_main.Cells(i, col_inventory_new_gmid).Value = ""
End If
i = i + 1
Loop
Workbooks(fileName).Close
fileName = Dir()
Application.ScreenUpdating = True
MsgBox "Actual inventory has been loaded successfully"
End Sub
This is where the macro stucks with the error message:
Related
hope you're fine,
i want a macro to read multiple excel files and insert a value in specific cell ( for example C3 or A1 or any cell declared in the code)
here firs image of my code, just a button
and here is my code:
Sub InsertValueInCell()
Range("C3").Value = _
InputBox(Prompt:="Enter the value you want to insert.")
End Sub
this code give me this result right now, it's just insert the data in the actual workbook :
TEST-1
TEST-2
Thanks in advance to help me to complete the code cause i want the code to read multiple excel files and after that i can insert a value in specific cell for all thos excel files.
Thanks in advance
Have a good day All
here is my code for the moment:
Sub InsertValueInCell()
Range("C3").Value = _
InputBox(Prompt:="Enter the value you want to insert.")
End Sub
this code give me this result right now, it's just insert the data in the actual workbook :
TEST-1
TEST-2
Thanks in advance to help me to complete the code cause i want the code to read multiple excel files and after that i can insert a value in specific cell for all those excel files (for example i want to insert a value in the C3 cell for all those excel files).
Thanks in advance
Have a good day All
This should work for you:
Option Explicit 'Must be at very top of module, before any procedures.
'Possibly the most important line in any code - forces you to declare your variables.
Public Sub AddValueToSheet()
On Error GoTo ERROR_HANDLER
'The Sheet to changed.
Dim SheetName As String
SheetName = "Sheet1"
'Get a collection of files within the folder.
Dim FileCollection As Collection
Set FileCollection = New Collection
Set FileCollection = EnumerateFiles("<folder path>\") 'Don't forget the final backslash.
Dim ValueToEnter As String 'or whatever type you're trying to enter.
ValueToEnter = InputBox("Enter the value you want to insert")
'Look at each item in the collection.
Dim wrkBkPath As Variant
For Each wrkBkPath In FileCollection
'Open the workbook.
Dim wrkBk As Workbook
Set wrkBk = Workbooks.Open(wrkBkPath)
'Check if the sheet exists.
'Add the value if it does, add the file name to the MissingSheetList string if it doesn't.
Dim MissingSheetList As String
If SheetExists(wrkBk, SheetName) Then
wrkBk.Worksheets(SheetName).Range("A1") = ValueToEnter
Else
MissingSheetList = MissingSheetList & wrkBk.Name & vbCrLf
End If
'Save and close.
wrkBk.Close SaveChanges:=True
Next wrkBkPath
'Display missing sheet list message if there's any.
If MissingSheetList <> "" Then
MsgBox "The files were missing " & SheetName & vbCr & vbCr & MissingSheetList, vbInformation + vbOKOnly
End If
Exit Sub
'If an error occurs code skips to this section.
ERROR_HANDLER:
Dim ErrMsg As String
ErrMsg = "AddValueToSheet()" & vbCr & Err.Description
'Add error handling code.
Select Case Err.Number
Case Else
End Select
End Sub
'Check if a sheet exists by trying to set a reference to it.
Private Function SheetExists(wrkBk As Workbook, SheetName As String) As Boolean
On Error Resume Next
Dim ShtRef As Worksheet
Set ShtRef = wrkBk.Worksheets(SheetName)
SheetExists = (Err.Number = 0) 'Was an error returned? True or False.
On Error GoTo 0
End Function
'Returns all xls* files from the path supplied by sDirectory.
'Each file path is added to the FilePaths collection.
Private Function EnumerateFiles(ByVal sDirectory As String) As Collection
On Error GoTo ERROR_HANDLER
'You can remove StatusBar lines if you want - code might run too fast to see anyway.
Application.StatusBar = "Collating files: " & sDirectory 'Update status bar.
Dim cTemp As Collection
Set cTemp = New Collection
Dim sTemp As String
sTemp = Dir$(sDirectory & "*.xls*")
Do While Len(sTemp) > 0
cTemp.Add sDirectory & sTemp
sTemp = Dir$
Loop
Set EnumerateFiles = cTemp
Application.StatusBar = False 'Reset status bar.
Exit Function
'If an error occurs code skips to this section.
ERROR_HANDLER:
Dim ErrMsg As String
ErrMsg = "EnumerateFiles()" & vbCr & Err.Description
'Add error handling code.
Select Case Err.Number
Case Else
End Select
End Function
Sorry for the long one, and it's probably something simple that I'm overlooking after so much time.
I'm writing a small program that in just a few clicks, pulls data from an actor's "deal memo" pdf and put's that info into one of four possible excel templates (in different sheets) to export as a new "contract" pdf.
The application identifies certain key words/values from other cells that determines which sheet/template is used.
The issue comes at the following step:
-Based on the keywords, I need the exported document to identify if a series of folders are created, and if not, create them, and step in to create more relevant folders before finally saving the file.
The structure example is as follows, relevant created folders in Bold:
C:\Work Folder\ Deal Memo to Contract\Exported Contracts\Episode Number\Actor Name\Contract Type\final.pdf
Each folder name is created based on variables pulled from cell values. It works just fine when I put the string variables in quotes for testing, and even when the variables are stated by themselves, it pastes the proper path in the admin cells as shown in the following picture - Range A14:A21
Screenshot of Dashboard Page, admin column to be hidden
But even though it looks like a proper path address in the cells, VBA throws a
Runtime error 52:Bad file name or number on line 56, "PlayerExFolder = Dir(PlayerExPath, vbDirectory)"
Like I said, it's probably something simple. Any help would be great as I'm still pretty new to this. Oh, and I'm working on the Daily_Direct section of the if statements, the others will be identical once this starts working. Thanks!
UPDATE - It turns out that I had narrowed it down to what I thought were extra spaces that were ruining the path/folder creation. They were invisible "Ghost" characters. Ended up using the Clean function on the cells that were being used to name the folders. Hope this helps someone in the future.
Sub export_pdf()
Application.ScreenUpdating = False
Dim MainExPath As String
Dim MainExFolder As String
MainExPath = Worksheets("Deal2Contract").Range("C3").Value & "\Exported Contracts"
MainExFolder = Dir(MainExPath, vbDirectory)
If MainExFolder = vbNullString Then
Answer = MsgBox("An export folder for the generated contracts does not exist, I will create one for you", vbOKCancel, "Create Contract Export Folder?")
Select Case Answer
Case vbOK
VBA.FileSystem.MkDir (MainExPath)
Case Else
End Select
End If
Worksheets("Deal2Contract").Range("A15").Value = MainExPath
Dim EpiExPath As String
Dim EpiExFolder As String
Dim currEp As Integer
currEp = Worksheets("Data").Range("F14").Value
EpiExPath = Worksheets("Deal2Contract").Range("A15").Value & "\" & currEp
Worksheets("Deal2Contract").Range("A17").Value = EpiExPath
Dim PlayerExPath As String
Dim PlayerExFolder As String
Dim CurrPlayer As String
CurrPlayer = Worksheets("Data").Range("F8").Value
PlayerExPath = Worksheets("Deal2Contract").Range("A17").Value & "\" & CurrPlayer
Worksheets("Deal2Contract").Range("A19").Value = PlayerExPath
Dim TypeExPath As String
Dim TypeExFolder As String
Dim CurrType As String
CurrType = Worksheets("Deal2Contract").Range("A7").Value
TypeExPath = Worksheets("Deal2Contract").Range("A19").Value & "\" & CurrType
Worksheets("Deal2Contract").Range("A21").Value = TypeExPath
If Worksheets("Deal2Contract").Range("A7").Value = "Weekly_Direct" Then
ElseIf Worksheets("Deal2Contract").Range("A7").Value = "Weekly_Loan" Then
ElseIf Worksheets("Deal2Contract").Range("A7").Value = "Daily_Direct" Then
EpiExFolder = Dir(EpiExPath, vbDirectory)
If EpiExFolder = vbNullString Then
VBA.FileSystem.MkDir (EpiExPath)
Else
End If
PlayerExFolder = Dir(PlayerExPath, vbDirectory)
If PlayerExFolder = vbNullString Then
VBA.FileSystem.MkDir (PlayerExPath)
Else
End If
TypeExFolder = Dir(TypeExPath, vbDirectory)
If TypeExFolder = vbNullString Then
VBA.FileSystem.MkDir (TypeExPath)
Else
End If
'dateExFolder = Dir(dateExPath, vbDirectory)
'If typeExFolder = vbNullString Then
' VBA.FileSystem.MkDir (currType)
'Else
'End If
ElseIf Worksheets("Deal2Contract").Range("A7").Value = "Daily_Loan" Then
End If
Worksheets("Deal2Contract").Range("A15").WrapText = False
Worksheets("Deal2Contract").Range("A17").WrapText = False
Worksheets("Deal2Contract").Range("A19").WrapText = False
Worksheets("Deal2Contract").Range("A21").WrapText = False
Worksheets("Deal2Contract").Range("A23").WrapText = False
Application.ScreenUpdating = True
End Sub
I got problems in making the files search using workbooks.open. When the macro is executed, it shows runtime error "1004". Actually, I learn this from YouTube.
Can anyone know what's the problems?
This code actually find multiple excel files in one folder that we path.
Sub checkcopy()
Dim cf As String
Dim erow
cf = Dir("C:\Supplier\")
Do While Len(cf) > 0
MsgBox ("Check")
If cf = "SummaryCheckFile.xlsm" Then
Exit Sub
End If
MsgBox ("Check 1")
Workbooks.Open (cf)
Range("A1:E1").Copy
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))
checkFile = Dir
Loop
End Sub
Sorry,
its show
'go.xls' not found be found. Check The spelling of the file name and verify the file location is correct.
If you are trying to open the file from your list of mostly recently used files, make sure.....
Dir() only returns the filename - it does not include the path, so you need to specify both of those when you call Workbooks.Open()
Also your loop will never exit (unless the first file is "SummaryCheckFile.xlsm") because all other calls to Dir() assign the return value to checkFile, so cf will never be cleared.
Sub checkcopy()
Const FLDR As String = "C:\Supplier\"
Const EXCLUDE_FILE As String = "SummaryCheckFile.xlsm"
Dim cf As String, c As Range, wb As Workbook
'set the first copy destination
Set c = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
cf = Dir(FLDR & "*.xls*", vbNormal) 'only Excel files
Do While Len(cf) > 0
Debug.Print cf
'opening this file ?
If UCase(cf) <> UCase(EXCLUDE_FILE) Then
Set wb = Workbooks.Open(FLDR & cf, ReadOnly:=True)
wb.Sheets(1).Range("A1:E1").Copy c 'assumes copying from the first sheet
Set c = c.Offset(1, 0) 'next destination row
wb.Close False
End If
cf = Dir 'next file
Loop
End Sub
Try to give the path of cf, for example cf = "c:\XXX\filename.xlsm", rather than cf = "filename.xlsm".
Try to work with the parameter CorruptLoad when opening the xlsm which contains macros and causing runtime errors and no response.
Application.DisplayAlerts = False
Workbooks.Open ("enter your file path here"), CorruptLoad:=xlExtractData
Application.DisplayAlerts = True
I have a value in a cell that should match the filename of a document in a directory.
Sheet3 Column A1 = C:\Users\Admin\Desktop\Folder1
Sheet3 Column A2 = test.xls
‘Location of directory
sCurrentXLDirectory = Worksheets("Sheet3").Cells(1, 1).Value
Set CurrentXLFSO = CreateObject("Scripting.FileSystemObject")
ProceedNow = True
Set CurrentXLFolder = CurrentXLFSO.GetFolder(sCurrentXLDirectory)
Set CurrentXLFiles = CurrentXLFolder.Files
‘Always 10 files in this folder
If CurrentXLFiles.Count <> 10 Then
MsgBox "Wrong Directory or Folder Mismatch"
ProceedNow = False
Else
'Return one for indentical filename
Dim NameCount As Integer
NameCount = 0
For Each folderIDX In CurrentXLFiles
‘Compare file names specified cell value
If folderIDX.Name = Worksheets("Sheet3").Cells(1, 2).Value Then
NameCount = NameCount + 1
If NameCount <> 1 Then
MsgBox "Unable to find file”
ProceedNow = False
End If
End If
Next
End If
For some reason, even if I change test.xls to test1.xls, it will still do Proceed = True
If a nested IF statement is not the preferable way to do this, please guide me in the right direction.
If the purpose of the procedure is verify if a file exists or does not exist, using the Dir() function would be much simpler.
If this is the goal, try the following code:
Sub test()
Dim sDirectory As String
Dim sFile As String
sDirectory = Worksheets("Sheet3").Cells(1, 1).Value
sFile = Worksheets("Sheet3").Cells(1, 2).Value
sFile = Dir(sDirectory & "\" & sFile, vbDirectory)
If Len(sFile) = 0 Then
MsgBox "Unable to find file"
End If
End Sub
The code you provided will not change a file name, so maybe this is just the beginnings of your attempt. What I found, though, is that Range("A2") is "Cells(2, 1)", not "Cells(1, 2)", as you currently have it. You are referencing cell B1, which probably does not contain a file name.
To alleviate such confusion in the future, always refer to one or the other, then such problems are avoided or easily diagnosed.
Such as:
If folderIDX.Name = Worksheets("Sheet3").Range("A2").Value Then
This should trip that "ProceedNow = False" flag that you are looking for.
I am trying to copy the string values(column titles) from another workbook in row 4 as captions for checkboxes in the workbook where I am running the code. This is what I have so far and it is not working because it is showing the error message "Subscript out of range, run time error 9" Here is what I have. After the error message pops up the line marked below is highlighted. Can anybody help me please. Thank you very much.
Function CallFunction(SheetName As Variant) As Long
Dim text As String
Dim titles(200) As String ' Dim titles(200) As String ' Array
Dim nTitles As Integer
Dim wks As Worksheet
Dim myCaption As String
PathName = Range("F22").Value
Filename = Range("F23").Value
TabName = Range("F24").Value
ControlFile = ActiveWorkbook.Name
Workbooks.Open Filename:=PathName & "\" & Filename
ActiveSheet.Name = TabName
Set wks = Workbooks("Filename").Worksheets(SheetName).Activate ' <= Highlights this line ****
For i = 1 To 199
If Trim(wks.Cells(4, i).Value) = "" Then
nTitles = i - 1
Exit For
End If
titles(i - 1) = wks.Cells(4, i).Value
Next
i = 1
For Each cell In Range(Sheets("Sheet1").Cells(4, 1), Sheets("Sheet1").Cells(4, 1 + nTitles))
myCaption = Sheets("Sheet1").Cells(4, i).Value
With Sheets("Sheet1").checkBoxes.Add(cell.Left, _
cell.Top, cell.Width, cell.Height)
.Interior.ColorIndex = 12
.Caption = myCaption
.Characters.text = myCaption
.Border.Weight = xlThin
.Name = myCaption
End With
i = i + 1
Next
End Function
Subscript out-of-range typically indicates that a specified Worksheet does not exist in the workbooks Worksheets collection.
Otherwise, are you sure that the workbook specified by FileName is already open? If not, that will raise the same error.
Ensure that A) the file is already open (or use the Workbooks.Open method to open it), and B) ensure that such a worksheet already exists (if not, you will need to create it before you can reference it by name).
Update
You have Workbooks("FileName") where "Filename" is a string literal. Try changing it to simply Filename (without the quotation marks) (this seems like the OBVIOUS error).
Also worth checking:
I also observe this line:
ActiveSheet.Name = TabName
If the sheet named by SheetName is active when the workbook opens, then that line will effectively rename it, so you will not be able to refer to it by SheetName, but instead you would have to refer to it by Worksheets(TabName). ALternatively, flip the two lines so that you activate prior to renaming:
Set wks = Workbooks(Filename).Worksheets(SheetName).Activate
ActiveSheet.Name = TabName
For further reading: avoid using Activate/Select methods, they are confusing and make your code harder to interpret and maintain:
How to avoid using Select in Excel VBA macros
If that is the case, then you could do simply:
Workbooks(Filename).Worksheets(SheetName).Name = TabName