I have a macro code to open several excel sheets one after the other (I only show 3 here):
Sub Macro1()
Workbooks.Open Filename:=Range("F19").Value, UpdateLinks:=0
ActiveWindow.Visible = True
Windows("Data Quality Checks - ITS v2.8.xlsm").Activate
Workbooks.Open Filename:=Range("F21").Value, UpdateLinks:=0
ActiveWindow.Visible = True
Windows("Data Quality Checks - ITS v2.8.xlsm").Activate
Workbooks.Open Filename:=Range("F23").Value, UpdateLinks:=0
ActiveWindow.Visible = True
Windows("Data Quality Checks - ITS v2.8.xlsm").Activate
End Sub
The 'Range' shows the cell with the specific file path.
Currently, if the macro does not find one of the files, it produces an error and the process is forced to stop. Is it possible to include an additional line code that if the file is not found in the specified path, then the process continues and does not stop (no debugging)?
This may helps:
Option Explicit
Sub Macro1()
Dim LastRow As Long, i As Long
Dim PathName As String, MissingFiles As String
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 19 To LastRow Step 2 '<- Start from 19 like the example and stop lastrow column A sheet 1. Loop every two.
PathName = .Range("A" & i).Value
If Len(Dir(PathName)) = 0 Then '<- Make sure you add the extension of the file.
If MissingFiles = "" Then
MissingFiles = PathName
Else
MissingFiles = MissingFiles & vbNewLine & PathName
End If
Else
Workbooks.Open Filename:=PathName, UpdateLinks:=0
ActiveWindow.Visible = True
' Windows("Data Quality Checks - ITS v2.8.xlsm").Activate
End If
Next i
MsgBox "Missing Files are: " & vbNewLine & MissingFiles
End With
End Sub
Sheet Structure:
Message Box :
Related
Thanks for all the help given here.
I am by no means a coder and spend hours searching forums and canabilising bits of code to create what I need. I built the below code to extract data from one workbook, based on the filter and then save as in a individual workbooks. This code worked really well for one workbook, but now I've tried to reuse it,it throws a 1004 runtime error when trying to save as. Any idea where it could be going wrong?
Many thanks,
Stephen
Sub Split()
Dim ws As Worksheet
Dim wsNew As Workbook
Dim rData As Range
Dim rfl As Range
Dim state As String
Dim myValue As Variant
Dim sfilename As String
Dim FolderName As String
Dim strDir As String
myValue1 = InputBox("What date is this save for? (Format: DD Month)")
Range("B1").Select
Selection.AutoFilter
Set ws = ThisWorkbook.Sheets("Combined Data")
With ws
Set rData = .Range(.Cells(1, 2), .Cells(.Rows.Count, 13).End(xlUp))
.Columns(.Columns.Count).Clear
.Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
MsgBox "Please select the folder to save files"
FolderName = GetFolder()
If FolderName = "" Then
MsgBox "No folder was selected. Program will terminate."
Exit Sub
End If
For Each rfl In .Range(.Cells(2, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))
state = rfl.Text
strDir = FolderName & "\" & state
If Dir(strDir, vbDirectory) = "" Then
MkDir strDir
Else
End If
Set wsNew = Workbooks.Add
sfilename = "Monday" & " " & myValue1 & " - Engagement" & ".xlsx"
ActiveWorkbook.SaveAs strDir & "\" & sfilename
You need to find out the actual reason for this common error code - 1004. Edit your function/VBA code and run your program in debug mode to identify the line which is causing it. And then, add below piece of code to see the error,
On Error Resume Next
// your code goes here which causes 1004 error
If Err.Number > 0 Then
Debug.Print Err.Number & ":" & Err.Description
End If
I'd suggest using debug shortcut keys on your keyboard - Step Into (F8), Step Over (Shift + F8), Step Out (Ctrl + Shift + F8)
I created a VBA macro that formats and creates charts out of raw data. I have added functionality to track usage of the macro and record usage (username, timestamp, client name) to a .txt file on our database.
The problem I am running into is that I want the usage tracker to be blind to the end user. However, I am getting windows popping up showing a save bar to the directory path. I've tried searching around for a solution to keep this hidden but I am unable to find any code that I'm able to implement to solve.
I expected the following inputs to hide all windows. I am not quite sure if I need more elaborate code to hide the save window.
Application.DisplayAlerts = False
Application.DisplayStatusBar = False
Application.ScreenUpdating = False
Application.EnableEvents = False�
Here is the code Im using to save usage:
'Usage Tracker'
On Error Resume Next
Dim wb As Workbook: Set wb = ActiveWorkbook
''''tracking file location
Dim strFilename As String: strFilename = "\\Ant\dept\CorporateDevelopment\BizDev\In-Shipment\ISO\zz_File_Location\macrotracking.txt"
Dim recordFile As Workbook
Set recordFile = Workbooks.Open(Filename:=strFilename)
Dim LastRow As Long
LastRow = recordFile.Sheets("macrotracking").Range("A1").SpecialCells(xlCellTypeLastCell).Row
wb.Activate
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "Performance" Then
exists = True
End If
Next i
If exists Then
Advertiser_Name = Sheets("Performance").Range("C3").Value
Else
Advertiser_Name = Sheets("Raw Data").Range("J2").Value
End If
MsgBox wb.Name & exists & Advertiser_Name
''''''these are the variables you want to track, just separate by '& ; &'
recordFile.Sheets("macrotracking").Range("A" & LastRow + 1).Value = Environ("USERNAME") & ";" & Format(Now(), "m/dd/yyyy") & ";" & Format(Now(), "hh:nn:ss") & ";" & ActiveSheet.Range("C3").Value & ";" & "TOTAL"
recordFile.Sheets("macrotracking").Range("A" & LastRow + 1).TextToColumns Destination:=Range("A" & LastRow + 1), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Semicolon:=True
recordFile.Save
recordFile.Close savechanges:=True
If Err <> 0 Then
Err.Clear
End If
On Error GoTo 0
'End Tracker'
I would greatly appreciate it if someone can help me learn how to hide all windows for this entire macro.
after converting my sheet into prn it gives error during upload on my erp ,when i convert prn into txt format i saw some kind of chinese written how to fix this problem. below code add value +1 in row "A" and convert into prn
Sub CONVERT()
Dim vcounter As Long
Dim ws As Worksheet
For Each ws In Sheets
ws.Activate
vcounter = 2
While Range("A" & vcounter).Value <> ""
Range("a" & vcounter).Value = Range("a" & vcounter).Value + 1
vcounter = vcounter + 1
Wend
Application.DisplayAlerts = False
ActiveSheet.SaveAs Filename:="D:\birla soft\" & ActiveSheet.Name & ".prn"
Next ws
End Sub
You're saving a .xlsm/.xlsx file with a .prn extension; that doesn't make it a .prn file, it's still a .xlsm/.xlsx file - the extension isn't what determines the file's format, it's just a convenient indicator for us puny humans to recognize what we're looking at when we browse through files. You want to supply a xlTextPrinter XlFileFormat argument to the SaveAs method:
ActiveSheet.SaveAs Filename:="D:\birla soft\" & ActiveSheet.Name & ".prn", xlTextPrinter
A note about this:
ws.Activate
You don't need it. Instead, qualify these Range calls with the ws object - and you want to iterate the Worksheets collection (Sheets may contain all kinds of non-worksheet sheet types):
For Each ws In ActiveWorkbook.Worksheets ' or did you mean to iterate sheets in ThisWorkbook?
Do While ws.Range(...)
ws.Range(...) = ws.Range(...) + 1
vcounter = vcounter + 1
Loop
Application.DisplayAlerts = False
ws.SaveAs FileName:="..." & ws.Name & ".prn", FileFormat:=xlTextPrinter
Next
I have 50 excel workbooks each containing 5 sheets inside. They all have the same structure, same sheet names, same column titles. I need to extract the 4th sheet from each file and put data in one single sheeted workbook under each other. I found this macro but it extracts on different sheets. I can't figure out how to modify this code to fit my needs. Can someone please advise?
Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No file is chosen"
GoTo ExitHandler
End If
x = 1
While x <= UBound(FilesToOpen)
Workbooks.Open Filename:=FilesToOpen(x)
Sheets("Associates report").Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub code here
Here's a macro for collecting data from all files in a specific folder.
Workbooks to 1 Sheet
The parts of the code that need to be edited are colored to draw your attention.
In the "this is the section to customize", the code:
LR = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
...would need to be something like this to copy from sheet 4:
LR = Sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Row 'Find last row
Sheets("Sheet4").Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
Or looking at your sample code above, maybe:
LR = Sheets("Associates Report").Range("A" & Rows.Count).End(xlUp).Row 'Find last row
Sheets("Associates Report").Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
It's intended as a generic starting point, you will have to go through and edit for your environment. Check the comments.
I have written an Excel VBA macro that compiles all the information from various spreadsheets that are located in a specific folder and compiles them into one 'Master' Excel workbook.
This currently works fine when using it on my computer, but I would like to adjust the code so that I can place the 'Master' spreadsheet and the folder containing the individual spreadsheet (the ones to be compiled) on a network drive, so that anyone can use it.
I am fairly new to VBA and coding in general so I have a strong feeling there is probably an easy solution to fix my issue.
I have attached my current macro that runs the absolute reference.
'Summary: Open all Excel files in a specific folder and merge data
' into one master sheet (stacked)
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wbkNew As Workbook
'Setup
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Set wbkNew = ThisWorkbook
wbkNew.Activate
Sheets("Master").Activate
If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
Cells.Clear
NR = 1
Else
NR = Range("A" & Rows.Count).End(xlUp).Row + 1
End If
fPath = "C:\Folder-that-Excel-workbooks-are-located-in"
On Error Resume Next
MkDir fPathDone
On Error GoTo 0
OldDir = CurDir
ChDir fPath
fName = Dir("*.xlsx")
Do While Len(fName) > 0
If fName <> wbkNew.Name Then
Set wbData = Workbooks.Open(fName)
LR = Range("C" & Rows.Count).End(xlUp).Row
If NR = 1 Then
Range("C5:F" & LR).EntireRow.Copy _
wbkNew.Sheets("Master").Range("A" & NR)
Else
Range("C5:F" & LR).EntireRow.Copy _
wbkNew.Sheets("Master").Range("A" & NR)
End If
wbData.Close False
NR = Range("C" & Rows.Count).End(xlUp).Row + 1
fName = Dir
End If
Loop
ErrorExit:
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
ChDir OldDir
One quick and dirty solution would be putting the path to the workbook folder somewhere into the master workbook.
Put the other workbooks on a network share that is available to all computers you are sharing your excel sheet with. Use a UNC path like this:
\\ComputerName\SharedFolder\Resource
You can then set fPath in your code to the cells value.
A better way would be putting the path into a settings file in the same folder as the master workbook and reading the path when running the macro:
Dim tmpArray() As String
Dim s As String
Dim strPath as String
Open ThisWorkbook.Path & "\settings.ini" For Input As #1
Do While Not EOF(1)
Line Input #1, s
If VBA.Left(s, 11) = "excelfolder" Then
tmpArray = Split(s, "=")
strPath = tmpArray(1)
End If
Loop
Close #1
Your ini file would look like this:
excelfolder=\\ComputerName\SharedFolder\Resource