I am trying to write a code that I copied from somewhere else.
The code is not working and gives me an error.
Can someone please review and advise if there is a syntax error
Dim directory As String, filename As String, sheet As Worksheet, total As Integer
Dim WrdArray() As String
Application.DisplayAlerts = False
directory = "U:\GMR & PAYROLL REPORTS 2018-19\FEBRUARY 2019\COMPLETED\PAYSLIPS\"
filename = Dir(directory & "*.csv")
Do While filename <> " "
Workbooks.Open (directory & filename)
WrdArray() = Split(filename, ".")
For Each sheet In Workbooks(filename).Worksheets
Wookbooks(filename).ActiveSheet.Name = WrdArray(0)
total = Workbooks("PAYSLIPS CONSOL.xlsm").Worksheets.Count
Workbooks(filename).Worksheets(sheet.Name).Copy after:=Workbooks("PAYSLIPS CONSOL.xlxm").Worksheets(total)
GoTo exitFor:
Next sheet
exitFor:
Workbooks(filename).Close
filename = Dir()
Loop
Sheets("ALL HOMES").Select
lastsheets = Worksheets.Count
For i = 2 To lastsheets
mysheet = Sheets(i).Activate
mysheetrow = Cells(Rows.Count, 1).End(x1Up).Row
Range("A1;U" & mysheetrow).Select
Selection.Copy
Sheets("ALL HOMES").Select
lastrow = Cells(Rows.Count, 1).End(x1Up).Row
Range("A1").Select
Range("A" & lastrow).Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Next i
MsgBox "Your Report is Ready"
Application.DisplayAlerts = True
End Sub
In general, you can use VBA compiler to check whether your project can compile. To do this in the VBA Editor, click Debug -> Compile VBA Project. Everytime you click it, it will either run smoothly and say nothing, or show you the first compilation error in the project it runs into (so you can fix it and click Compile again).
I tried to compile the code you posted:
First, as suggested in the comment, you don't have the Sub line at the top. For example
Sub create_payroll()
, where create_payroll is your preferred name for this macro. Put this line right above all the code you posted in the question.
Second, there is a typo "Wookbooks" instead of Workbooks.
Related
I'm trying to write a vba code to save a specific worksheet as another workbook file. I want the user to be able to name the workbook file and path.
I tried different approaches but none of them worked.
If that's not possible, I'm ok with only saving to this location:
"Q:\Sorular\"
Spesific filename is shown in codes.
Sub Soru_Publish()
Dim fName1 As String
fName1 = Worksheets("Storyboard").Range("E3").Value & "_" & Worksheets("Storyboard").Range("E2").Value
Worksheets("Soru_Publish").Visible = True
Worksheets("Soru_Publish_2").Visible = True
Worksheets("Soru_Publish").Activate
Dim FirstBlankCell As Long, rngFound As Range
With Sheets("Soru_Publish")
Set rngFound = .Columns("A:A").Find("*", After:=.Range("A1"), _
searchdirection:=xlPrevious, LookIn:=xlValues)
If Not rngFound Is Nothing Then FirstBlankCell = rngFound.Row
End With
Worksheets("Soru_Publish").Range("A1:Y" & FirstBlankCell & "").Copy
Worksheets("Soru_Publish_2").Range("A1:Y" & FirstBlankCell & "").PasteSpecial Paste:=xlPasteValues
Worksheets("Soru_Publish_2").Copy
With ActiveWorkbook
.SaveAs filename:="Q:\Sorular\" & filename
.Close
End With
Worksheets("Sorular").Activate
Worksheets("Sorular").Range("B4").Select
Worksheets("Soru_Publish").Visible = False
Worksheets("Soru_Publish_2").Visible = False
End Sub
Unfortunately when I run the macro, I get Run-time error '1004' at SaveAs line.
Your code works, but using ActiveWorkbook can give you unexpected results.
If you want to save a single sheet as a new .xls file, just use .SaveAs directly on the sheet you need to save, like this:
Dim wrkSheet As Worksheet
Set wrkSheet = Worksheets("Soru_Publish_2")
wrkSheet.SaveAs Filename:="Q:\Sorular\" & fName1
Or like this if you don't want to define a new variable:
Worksheets("Soru_Publish_2").SaveAs Filename:="Q:\Sorular\" & fName1
Hope this helps.
Sorry, I forgot to change the " filename " to " fName1".
Code works just fine, it was just a typo.
I am working on making a universal production time sheet(wbTime) for each dept that will work across all shifts and lines. I have where all the necessary information is required to be entered, all the data getting copied into a table in another workbook(wbLog) and saved to be able to do analysis on the production data.
However, when it gets to trying to save the actual time sheet in the proper folder according to shift and machine line I start running into problems. I have it pulling part of the path from certain cells and the filename form the date the enter. It is getting to the last line and throwing a run-time error 1004 "Method 'SaveAs' of object_Worbook'failed".
I have only been playing with vba for 2 months so it is probably something small that I just do not see...
Sub TransferData()
If ActiveSheet.Range("E2").Value = "" Then
MsgBox "Operator Name Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("H2").Value = "" Then
MsgBox "Date Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("K2").Value = "" Then
MsgBox "Shift Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
If ActiveSheet.Range("M2").Value = "" Then
MsgBox "Line Required", vbInformation, "ALERT: Missing Information"
Cancel = True
Exit Sub
End If
Dim wbTime As Workbook
Set wbTime = ThisWorkbook
Dim wbData As Workbook
Dim LastRow As Long
Set wbTime = ActiveWorkbook
With wbTime.Sheets("Production Time Sheet")
LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With
wbTime.Sheets("Production Time Sheet").Range("A6:R" & LastRow).Copy
Set wbData = Workbooks.Open("S:\Lean Carrollton Initiative\Michael\Time Sheet Data LT Test.xlsm")
Set wbData = ActiveWorkbook
wbData.Worksheets("Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbData.Close SaveChanges:=True
Dim Fname As String
Dim Path As String
Dim shft As String
Dim Line As String
Set wbTime = ActiveWorkbook
Fname = Sheets("Production Time Sheet").Range("I2").Text
shft = Sheets("Production Time Sheet").Range("Z9").Text
Line = Sheets("Production Time Sheet").Range("AC11").Text
Path = "K:\Groups\OFS Time Sheets\8hr Production Schedule\LT Jacketing\" & shft & Line & Fname & ".xlsx"
ActiveWorkbook.SaveAs filename:=Path, FileFormat:=xlNormal
End Sub
You are using as name of file the text 2/5/2019.xlsx. As far as I know, the simbol / cannot be used in Windows to name a file.
Try with a different name for file. Something like:
Fname = Replace(Sheets("Production Time Sheet").Range("I2").Text,"/","-")
a) Don't use Range.Text, use Range.Value2.
Text will give you exactly what is written in the cell, and if the cell diplays ###because your cell is to narrow to display a number, it will give you ###.
b) Put a statement Debug.print path before the SaveAs and check in the immediate window (Ctrl+G) if the path is exactly what you expect.
c) Be sure that when you issue the SaveAs-command, the same file is not already open in Excel - this happens often when you test your code repeatedly (it may still open from the last test). SaveAs saves a copy of the file and keeps it open!
d) Use FileFormat:=xlOpenXMLWorkbook when you name the file with extension xlsx. xlNormal will save the file with the old Excel file format and expects xls as extension.
e) Try to save the file with exactly the name from the Excel SaveAs dialog to see if the filename is okay and you have permission to save a file.
I've been using a function from another StackOverflow question (I'm SO sorry I can't find the original answer!) to help go through a number of cells in Column L that contains a formula that spits our a hyperlinked filepath. It is meant to open each one (workbook), update the values, then save and close the workbook before opening the next one. See below.
Sub List_UpdateAndSave()
Dim lr As Long
Dim i As Integer
Dim WBSsource As Workbook
Dim FileNames As Variant
Dim msg As String
' Update the individual credit models
With ThisWorkbook.Sheets("List")
lr = .Cells(.Rows.Count, "L").End(xlUp).Row
FileNames = .Range("L2:L" & lr).Value
End With
For i = LBound(FileNames, 1) To UBound(FileNames, 1)
On Error Resume Next
If FileNames(i, 1) Like "*.xls*" Then
Set WBSsource = Workbooks.Open(FileNames(i, 1), _
ReadOnly:=False, _
Password:="", _
UpdateLinks:=3)
If Err = 0 Then
With WBSsource
'do stuff here
.Save
.Close True
End With
Else
msg = msg & FileNames(i, 1) & Chr(10)
On Error GoTo 0
End If
End If
Set WBSsource = Nothing
Next i
If Len(msg) > 0 Then
MsgBox "The Following Files Could Not Be Opened" & _
Chr(10) & msg, 48, "Error"
End If
End Sub
The problem now is I am using this to work on a Network drive, and as a result it cause pathing issues with the Connections/Edit Links part. Each of the files are stored on S:\... which as a result of using the Hyperlink formula, won't be able to find the source data. See below the example image of a file that as been opened through a hyperlink cell from my original workbook. When I go to update the Edit Links section of it, it shows these errors.
If I open that lettered drive in Windows Explorer and find the file, it works with no problems. Open, Update Values > Save > Close, it says unknown...
(but if I click Update values here they update correctly.)
If opened using a Hyperlink formula in a cell (Also directing to S:\..) it says it contains links that cannot be updated. I choose to edit links and they're all "Error: Source not found". The location on them also starts off with \\\corp\... and not S:\.
Anyway to fix this? Apologies for the long winded question.
I'm adding this as an answer as it contains code and is a bit long for a comment.
I'm not sure if it's what you're after though.
The code will take the mapped drive and return the network drive, or visa-versa for Excel files. DriveMap is the variable containing the final string - you may want to adapt into a function.
Sub UpdatePath()
Dim oFSO As Object
Dim oDrv As Object
Dim FileName As String
Dim DriveMap As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
FileName = Range("A1")
If InStr(oFSO.GetExtensionName(FileName), "xls") > 0 Then
For Each oDrv In oFSO.drives
If oDrv.sharename <> "" Then
'Changes \\corp\.... to S:\
If InStr(FileName, oDrv.sharename) = 1 Then
DriveMap = Replace(FileName, oDrv.sharename, oDrv.Path)
End If
'Changes S:\ to \\corp\....
' If InStr(FileName, oDrv.Path) = 1 Then
' DriveMap = Replace(FileName, oDrv.Path, oDrv.sharename)
' End If
End If
Next oDrv
End If
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 am quite new to excel VBA macros so my problem should be easily solved.
I am trying to open all files in one folder, edit those files a little bit and copy them to existing workbook. Unfortunately, run-time error '424': Object required, occurs.
Highlighted is row:
ActiveSheets.Copy After:=Workbooks("Macro sheets.xlsm").Sheets(Sheets.Count)
It looks like "Macro sheets.xlsm", does not exists, but that is the name of workbook, from which I run this macro.
I have went through many forums, tried a lot of codes, but still did not find the solution.
Please, can somebody help me?
Thank you a lot,
Jan
Sub nahranidat()
Dim YourFile As Variant
Dim YourFolderPath As Variant
YourFolderPath = "K:\MMR\2015\BO\macro files connection\"
ChDir YourFolderPath
YourFile = Dir(YourFolderPath & "*.*")
Do While YourFile <> ""
Workbooks.Open Filename:=YourFolderPath & YourFile
YourFile = Dir
Set myObject = ActiveWindow
If Activeworkbook.Worksheets.Count = 2 Then
Sheets(1).Select
ActiveSheet.Name = Left(Activeworkbook.Name, InStr(Activeworkbook.Name, ".") - 1) & "_1_month"
Sheets(2).Select
ActiveSheet.Name = Left(Activeworkbook.Name, InStr(Activeworkbook.Name, ".") - 1) & "_by_month"
Activeworkbook.Sheets.Select
ActiveSheets.Copy After:=Workbooks("Macro sheets.xlsm").Sheets(Sheets.Count)
Else
Sheets(1).Select
ActiveSheet.Name = Left(Activeworkbook.Name, InStr(Activeworkbook.Name, ".") - 1)
Activeworkbook.Sheets.Select
ActiveSheets.Copy After:=Workbooks("Macro sheets.xlsm").Sheets(Sheets.Count)
End If
Application.CutCopyMode = False
myObject.Close , SaveChanges:=False
Loop
End Sub
You've referenced ActiveSheets instead of ActiveSheet so VBA will assume you have created a new object. Just change that line to
ActiveSheet.Copy After:=Workbooks("Macro sheets.xlsm").Sheets(Sheets.Count)
It is good practice to declare Option Explicit at the top of each module, that way a 'variable not defined' error makes it easier to spot typographical errors in variable/object names. You can set this automatically by going to VBA>Tools>Options>Editor>Require Variable Declaration.