I currently use a lot of spreadsheets to do my job that visualize incoming data that is always changing.
The main issue that I have run into is the file that I export every day has a naming system that is based on some algorithm that has relation to the date and time that the information was pulled, but is somewhat generated at random. This means that the workbook always has a different name and because of the copious amounts of reports that we pull, I prefer to be able to extract the information, transfer it to the main sheet, and delete the exported file. The macro that I came up with through recording my actions works fine if ALL other Microsoft applications are closed (if Word, Outlook, or another Excel file are open, the macro crashes with a define error).
Can anyone suggest a solution for being able to execute a code to format a file when the name is constantly changing? I can paste an example of what I have, but it's a long code due to the formatting. The basics are:
Sub RECORDTHIS()
Dim sht As Object
Set sht = ActiveWorkbook.ActiveSheet
sht.Select
sht.Name = "MYDATA"
'Lots of formatting commands
End Sub
Why don't you "Open" the workbook you want to process. Something like this
Sub DemoOpen()
Dim FName As Variant
Dim wb As Workbook
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls")
If FName <> False Then
Set wb = Workbooks.Open(FName)
Dim sht As Worksheet
Set sht = wb.ActiveSheet
sht.Name = "MYDATA"
'Lots of formatting commands
End If
End Sub
Related
I build a xlsm file that takes a database of a few hundred lines as input, processes them and outputs a few seperate .xlsm files, each containing some rearanged part of the input.
I would like to add a simple "Worksheet_BeforeDoubleClick" sub to each of the generated output files.
when working through the input, at the end of the for loop, I do the following:
Dim numLines As Integer
Set CodeCopy = ThisWorkbook.VBProject.VBComponents("Module2").CodeModule
numLines = CodeCopy.CountOfLines
NewBook.VBProject.VBComponents("Sheet1").CodeModule.AddFromString CodeCopy.Lines(1, numLines)
AccessMode:=xlExclusive, _
ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
NewBook.Saved = False
NewBook.SaveAs Filename:="cw_" & cw & "_" & myVendors(N), _
ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges, _
FileFormat:=52
NewBook.Close
If I add a break before the "NewBook.Close", everything seems to work. The split file is shown as a seperate project and "Sheet2" contains the required code.
If I let the sub resume, the file is closed but if I reopen it manually the code is gone.
If I instead stop at the "NewBook.Close" and save the split file seperately the code remains in the file.
I have no idea why your code is gone after save - however, I generally think writing code using the VBE is not a good idea. And you need to allow this in the Trust Center Settings where it is usually disabled (for good reasons).
It is much easier to put the code into a template worksheet that sits in your workbook where your code sits. When create the new workbook, you simply copy this template sheet into it and voilà, all the code is copied with it. You can also put some formatting into the template - no need to do the formatting via code.
If you want, you can completely hide the template sheet - you just have to temporarily set it to visible before you copy it (use Application.ScreenUpdating = False to prevent flicker).
If you use the Copy-method of a worksheet without parameters, Excel will create a new Workbook with only this sheet. Of course, you can also create the new Workbook and use the Copy-method with Before or After-parameter.
Const TemplateSheetName = "Template"
With ThisWorkbook.Sheets(TemplateSheetName)
Application.ScreenUpdating = False
Dim saveVisibility As Long
saveVisibility = .Visible§
.Visible = xlSheetVisible
.Copy
.Visible = saveVisibility
Application.ScreenUpdating = True
End With
Dim newWb As Workbook, newWS As Worksheet
Set newWb = Workbooks(Workbooks.Count)
Set newWS = newWb.Sheets(TemplateSheetName)
newWS.Name = "MyNewDataSheet" ' You should assign a new name to the sheet
Good day all:
I'm trying to use a ActiveX command button to copy excel worksheets into another file. Here's the background:
I have excel log sheets that are being filled up every day. The logs have a set criterion (A, B, C, etc.) being run daily. While we still want to keep the logs in a daily file, I want a command button to be able to export to another workbook as a master file (e.g. "A_Masterfile", "B_Masterfile", etc.).
I've tried researching, but all these requirements come from different sites/pages. But since the method they use are so different, I'm having a hard time trying to get all Syntax to fit so that one code can do everything.
As a rundown, here's what I want it to do:
Export active worksheet to another workbook
a) If workbook exists, copy sheet to end of workbook
b) If workbook does not exist, create workbook and copy sheet
Destination workbook is based on a cell (criterion A, B, etc.)
Destination workbook might be in a different folder as source worksheet/workbook
Based on what I'm researching so far, this is what I'm turning up with.
When simply copying, this is what I read, but I could not get it to work.
ActiveSheet.Copy After:=Workbooks("Destination.xlsx").Worksheets(Worksheets.Count)
For Creating New File, this is what I read, but even from the original site, they said the problem was it copies the whole workbook, not just one specific sheet.
ActiveWorkbook.SaveAs "C:\path\Destination.xlsx"
Finally, I read about concatenation to create "Destination" file name based on a cell value. However, I got so lost with all the syntax. I tried simply copy pasting but I couldn't get it to work.
This is quite a bit to ask. Thanks so much in advance for all your help!
Please let me know if I can clarify anything.
P.S. Extra note: I've done some QBasic and MATLAB and a tiny bit of JAVA programming in school, so I got the logic part down. But I am quite new to VBA syntax, so extra information would be appreciated. :)
Update:
I just learned about "Record Macro" and I tried using it
I got this from it and it works:
Sheets("SourceSheet").Select
ActiveSheet.CheckBoxes.Add(639, 30, 58.8, 16.8).Select
ActiveSheet.CheckBoxes.Add(639.6, 44.4, 58.8, 16.8).Select
ActiveSheet.CheckBoxes.Add(639.6, 61.2, 58.8, 16.8).Select
ActiveSheet.OptionButtons.Add(1279.8, 37.8, 20.4, 18).Select
ActiveSheet.OptionButtons.Add(1280.4, 57, 21.6, 17.4).Select
Sheets("SourceSheet").Copy After:=Workbooks("DestinationMasterFile.xlsx").Sheets(1)
Windows("SourceWorkBook.xlsm").Activate
It works, but only put it after the first sheet instead of putting it in the end. I know it comes from the .Sheets(1), but I don't know how to write it otherwise. Thanks.
I have done a lot more research and trial and error, and I came up with a working code. This might be messy, but it works. Any further improvements are appreciated.
Private Sub CommandButton1_Click()
'Code for Locking
Sheets("W").Unprotect
Range("A1:BZ125").Locked = True
Sheets("W").Protect Password:="hello"
'Code for Copying
'Declarations
Dim Wk As Workbook
Dim FName As String
Dim FNameTwo As String
Dim FilePath As String
Dim TestStr As String
Dim wb As Workbook
'Initializing Constants
Set wb = ThisWorkbook
FName = "C:\Users\PHReyesDa\Desktop\" & Range("BO1") & ".xlsx"
FNameTwo = Range("BO1") + ".xlsx"
'If statement Setup (if exist)
FilePath = FName
TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
'If statement
If TestStr = "" Then
'If not existing, create new file
MsgBox "File didn't exist yet; new file created"
Set Wk = Workbooks.Add
Application.DisplayAlerts = False
Wk.SaveAs Filename:=FName
Application.DisplayAlerts = True
Workbooks(FNameTwo).Close SaveChanges:=True
End If
'Reopens Master File
Workbooks.Open FName
wb.Activate
'Find number of worksheets in destination workbook to worksheet could be copied to end of workbook
Dim Num As Integer
Num = Workbooks(FNameTwo).Worksheets.Count
'Copy source worksheet to (the end of) destination workbook
Sheets("W").Select
Sheets("W").Copy After:=Workbooks(FNameTwo).Worksheets(Num)
'Close and save new workbook, confirmation of successful copy
Workbooks(FNameTwo).Close SaveChanges:=True
MsgBox "Worksheet successfully exported and saved to master file"
End Sub
I have the the following code which creates a csv file for an excel file .It is working fine if i specify the worksheet number (like 1,2 etc) but i want to specify the sheet name.The sheet name may contain some space before or after the name.And this is the problem.I think i should use regular expression but i am not able to figure out how.If the file does contain extra space and if i do not handle it i get a subscript out of range error .
src_file = objFSO.GetAbsolutePathName(Wscript.Arguments.Item(0))
dim mine(1)
mine(0)="
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
Dim oBook
Set oBook = oExcel.Workbooks.Open(src_file)
oBook.Worksheets("Failure Report").Activate
oBook.SaveAs mine(0), csv_format
oExcel.Quit
If the worksheet name can only be approximated when you try to reference it, then you don't have a lot of choice but to loop over the target workbook's worksheets to find a match. Perhaps something like this (I'm assuming you can adapt this to suit your specific requirements):
Sub test()
Dim ws As Worksheet
Dim aWsName As String
aWsName = "Failure Report"
For Each ws In ActiveWorkbook.Worksheets
If InStr(1, ws.Name, aWsName) > 0 Then
ws.Activate
ActiveSheet.[A1] = "Matched!"
End If
Next
End Sub
Although not perfect for all situations, the code is trying to find the worksheet name aWsName in the name of one of the active workbook's worksheets. The reason it's not perfect is because it doesn't care what characters come before or after the string aWsName that you're looking for. If the names are sufficiently different, then this shouldn't be a problem. You can at least give it a go and see how it works for you.
A non-IT related class has been assigned a group project where the work they do will be stored is a single .xlsx file. The members decided the best way to collaboratively edit said file would be to split it into its constituent sheets, upload each *.xlsx sheet to an SVN repository, and use locks and a .txt file to organize sheet/member responsibility.
The group has accomplished the splitting of said files with a VB script (courtesy of this wonderful site) which was as follows:
Sub SaveSheets()
Dim strPath As String
Dim ws As Worksheet
Application.ScreenUpdating = False
strPath = ActiveWorkbook.Path & "\"
For Each ws In ThisWorkbook.Sheets
ws.Copy
'Use this line if you want to break any links:
BreakLinks Workbooks(Workbooks.Count)
Workbooks(Workbooks.Count).Close True, strPath & ws.Name & ".xlsx"
Next
Application.ScreenUpdating = True
End Sub
Sub BreakLinks(wb As Workbook)
Dim lnk As Variant
For Each lnk In wb.LinkSources(xlExcelLinks)
wb.Breaklink lnk, xlLinkTypeExcelLinks
Next
End Sub
Therewith the group now has a repository where each member is currently in the process of editing their respective files. The question then is, how can we automate the re-unification of these files into one .xlsx file with the preservation of the original links.
EDIT 4/2: started bounty // I'm aware that the links were "broken" by the above script but am not exactly sure what this means though I suspect it would make re-assembly with the preservation of original links more difficult. It should be noted that the original file which had the links is still available and might could be used to assist with this problem.
EDIT 4/2: Excel version is 2010--original links do not exist in current files.
EDIT 4/3: Original links are not in the current files, but it is desired that with the re-unification the original links (from original unedited file, pre-splitting) be re-created/preserved.
If you have SharePoint, you can all update the same Excel (2003 or 2010) book.
http://office.microsoft.com/en-us/excel-help/about-shared-workbooks-HP005262294.aspx
The links then don't really apply in the solution, as you said the original doesn't have any links and so reassembly with links isn't required.
The script provided even has a comment embedded saying "Use this line if you want to break any links:". So if you comment the line below out (prepend the line with a ') it will preserve the links in the child workbooks.
Using the answer to a previous question on copying sheets to another workbook reassembly can be accomplished with the following VBA:
Sub CombineSheets()
Dim strPath As String
Dim ws As Worksheet
Dim targetWorkbook As Workbook
Set targetWorkbook = ActiveWorkbook
Application.ScreenUpdating = False
'Adjust path location of split files
strPath = "C:\code\xls-split"
Dim str As String
'This can be adjusted to suit a filename pattern.
str = Dir(strPath & "\*.xl*")
Do Until str = ""
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(strPath & "\" & str, UpdateLinks:=0)
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
Next Sheet
wbResults.Close SaveChanges:=False
str = Dir()
Loop
Application.ScreenUpdating = True
End Sub
This will append the other workbooks to the currently opened workbook.
Sourced Replacing FileSearch function for code to find xls files in a directory.
We probably need more detail in order to help you, but you may be able to accomplish what you need as follows (maybe this can kick-start a solution):
Loop through the sheets in the workbook
For each sheet
Open the appropriate xlsx file
Identify non-formula cells
For each of those cells
Copy to the identical location in the main workbook
Close the xlsx file
Below is an example (based on your SaveSheets code). If you try this, be sure to backup everything first. We obviously don’t know how the spreadsheets are laid out and how they are used. It would really suck if it got all screwed up. Also, there are some assumptions:
The layout and used range in the xlsx files are the exact same layout and used range as it appears in the original workbook.
The links you are referring to are formulas (either to another sheet or another workbook).
If these assumptions are wrong, you will need to modify as appropriate (identifying specific ranges to copy and/or adding more robust logic to the routine).
Note that the actual code to do this is very short. I added comments and basic error handling which significantly increased the amount of code.
This code would be added to the original workbook.
Sub RetrieveSheets()
Dim strPath As String
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim wbk As Workbook
Dim rng As Range
Application.ScreenUpdating = False
strPath = ActiveWorkbook.Path & "\"
For Each ws In ThisWorkbook.Sheets
'Open the xlsx file (read only)
Set wbk = Nothing
On Error Resume Next
Set wbk = Workbooks.Open(strPath & ws.Name & ".xlsx", ReadOnly:=True)
On Error GoTo 0
'Continue if xlsx file was successfully opened
If Not wbk Is Nothing Then
Set ws2 = Nothing
On Error Resume Next
Set ws2 = wbk.Worksheets(ws.Name)
On Error GoTo 0
'Continue if appropriate sheet was found
If Not ws2 Is Nothing Then
'Identify cells to copy over (cells that are constants)
For Each rng In ws2.Cells.SpecialCells(xlCellTypeConstants)
'set the cell value equal to the identical cell location in the xlsx file
If (Left(ws.Range(rng.Address).Formula, 1)) <> "=" Then
ws.Range(rng.Address) = rng
End If
Next
Set ws2 = Nothing
End If
'Close the xlsx file
wbk.Close False
End If
Next
Set wbk = Nothing
Application.ScreenUpdating = True
End Sub
This is a rough outline of how I accomplished this:
Use Office2013 and not office 2010
create tmp/ directory with original .xlsx assignment file.
create source/ directory in tmp/
use split sheets module (listed on this page), but comment out the line that break links.
place all of the resulting .xlsx files into source/ (you can delete the original .xlsx file)
remote the first sheet from the sources/ folder, and place it ../
Open this first sheet, and import/use the 'combinesheets' module listed on this page.
Save the sheet, reopen it and you'll be prompted to update links. Do so, and select "change source" and select the first sheet Re in step 6.
links will automatically update; done.
Notes: you'll have to save a file as macro enabled, ...
Take a look at this MSDN Article on Merging Data from multiple workbook (.xls/.xlsx) files
http://msdn.microsoft.com/en-us/library/office/gg549168%28v=office.14%29.aspx
I don't know much about VBA but I think this is what you are looking for.
Also note it does get rid of the need for a text file to manage the files
I'm in the process of refactoring a huge workbook woth a lot of legacy parts, redundant computations, cross-dependencies etc.
Basically, I'm trying to remove unneeded sheets and implement some proper information flow within the workbook. Is there a good way to extract the dependencies between the sheets (with VBA)?
Thanks
Martin
You can use ShowPrecedents and NavigateArrow.
here is some pseudocode
for each oCell in oSht containing a formula
ocell.showprecedents
do until nomoreprecedents
i=i+1
Set oPrec = oCell.NavigateArrow(True, 1, i)
If not oPrec.Parent Is oSht Then
' off-sheet precedent
endif
loop
next ocell
I came up with a little sub to do this. It moves all the sheets into seperate workbooks and prints out the dependencies. The advantage over using showPrecedents is that it captures all links including names, embedded forms/diagramms etc.
Word of warning: Moving worksheets isn't undo-able, save your workbook before running this and close (without saving) and re-open afterwards.
Sub printDependencies()
' Changes workbook structure - save before running this
Dim wbs As VBA.Collection, wb As Workbook, ws As Worksheets
Dim i As Integer, s As String, wc As Integer
Set ws = ThisWorkbook.Worksheets
Set wbs = New VBA.Collection
wbs.Add ThisWorkbook, ThisWorkbook.FullName
For i = ws.Count To 2 Step -1
ws(i).Move
wc = Application.Workbooks.Count
wbs.Add Application.Workbooks(wc), Application.Workbooks(wc).FullName
Next
Dim wb As Workbook
For Each wb In wbs
For Each s In wb.LinkSources(xlExcelLinks)
Debug.Print wb.Worksheets(1).Name & "<-" & wbs(s).Worksheets(1).Name
Next
Next
End Sub
The code isn't very polished or user-friendly, but it works.
You can follow the steps at "Find external references that are used in cells" topic of the following link:
Find external references in a worbook
But instead of enter the "[" you should enter the name of the sheet you're trying to find its dependencies. It will display a large list of every single cell referencing the sheet, but at the end it works. Haven't find the way to group by Sheet.