Referencing Previous Version of File using Filename - excel

I am saving workbooks with v[ ] next to them to differentiate between latest and earlier versions.
Workbook v1
Workbook v2
...
Workbook v365
Is there a way to create a dynamic formula that does the following:
Detects the current version (365)
References a specific cell (e.g. A2) in the previous version (Workbook v364)
Please let me know! Any help would be really appreciated.

Since you did not answer my clarification questions, the next code will assume that the current workbook is the active one, all versions exist in the same folder and the "reference cell" will be a range in the previous version workbook where from a value must be extracted and it will be found in a sheet named as the active one in the current workbook:
Sub referenceThePrevVersion()
Dim wb As Workbook, curVers As Long, curName As String
Dim prevVersName As String, refVal As Variant, arrCur
Const refCell As String = "A2"
Set wb = ActiveWorkbook 'it my be ThisWorkbook if you need this one where the code exists
curName = wb.name 'the current workbook name
arrCur = Split(curName) 'split its name by spaces and place the words in an array
curVers = CLng(Mid(Split(arrCur(UBound(arrCur)), ".")(0), 2)) 'extract the current version
prevVersName = VBA.replace(curName, "v" & curVers, "v" & curVers - 1) 'obtain the prev version decreasing a unit
'extract the value of refCell, without opening the previous workbook:
refVal = CellV(wb.Path & "\", prevVersName, wb.ActiveSheet.name, Range(refCell).address(, , xlR1C1))
MsgBox refVal 'show the extracted value...
End Sub
Private Function CellV(fpath As String, fName As String, SheetName As String, strRange As String) As Variant
Dim strForm As String
strForm = "'" & fpath & "[" & fName & "]" & SheetName & "'!" & strRange
CellV = Application.ExecuteExcel4Macro(strForm)
End Function
The extracted value is CellV. It now is shown in a message, you may use it as you need.
Of course, if you know the previous version name and its path, you can open it and do whatever you need with its data.
Please, send some feedback after testing the code. If something not clear enough, do not hesitate to ask for clarifications.

Related

Excel vba for exporting cell content to TXT file

I have an Excel file (https://www.dropbox.com/s/hv9u68s136es190/Example2.xlsx?dl=0) with in column A all the persons and in the cell next to there name text (column B).
I want to save for every person a text file containing the text in the cell next to there name.
The filename should be called like the persons name.
So in this case i would have three text files. I do not know how to manage this using VBA in Excel.
Can someone help me with this?
Try this code, please. But, you must initially try something on your own. We usually help people correct their code and learn...
The text files will be named like the people names in column A. The folder where they will be saved will be the one of the workbook which keeps the active sheet. You can define it as you need, of course.
Option Explicit
Sub SaveTxtNamePlusTekst()
Dim sh As Worksheet, lastR As Long, i As Long, strPath As String
Set sh = ActiveSheet ' use here the sheet you need
strPath = sh.Parent.path 'you can define here the path you wish...
If Dir(strpath, vbDirectory) = "" Then MsgBox "The folder path is not valid...": Exit Sub
lastR = sh.Range("A" & Cells.Rows.Count).End(xlUp).row 'Last row in A:A
For i = 2 To lastR
'calling a Sub able to create a text file in a folder and put text in it
WriteText sh.Range("A" & i).value, strPath, sh.Range("B" & i).value
Next i
End Sub
Private Sub WriteText(strName As String, strPath As String, strText As String)
Dim filePath As String
filePath = strPath & "\" & strName & ".txt" 'building the txt file path
FreeFile 1
Open filePath For Output As #1
Print #1, strText 'write the text
Close #1
End Sub

Why am I getting an object required error when trying to get user input for the name of a workbook

I'm trying to insert formulas into my worksheet, but my first and second attempts haven't gone so well.
So, first I thought it would be better to use the GetOpenFilename feature for accuracy's sake, rather than having the user input the name of the workbook themselves. I used this page and this answer while writing it. When I run the code, the Open dialogue box opens, but when I select a workbook I keep getting a:
"Runtime Error '424': object required".
I'm not sure what it's asking for? At first I had just Application.GetOpenFilename(), so I thought I needed to add the filter, but it didn't help.
Sub openfile()
Dim mainwb As Workbook
Set mainwb = Application.GetOpenFilename("Microsoft Excel Files, *.xls*")
Dim mainws As Worksheet
mainws = InputBox("Please enter the name of the worksheet")
Dim rdsMonthly As Variant
rdsMonthly = InputBox("Please insert current month column in format $A:$A")
Dim rdsID As Variant
rdsID = InputBox("Please insert ID column in format $A:$A")
Cells(8, 14) = "=IFERROR(SUMIFS('[" & mainwb & "]" & mainws & "'!" & rdsMonthly & ", '[" & mainwb & "]" & mainws & "'!" & rdsID & ", $C55), " & Chr(34) & Chr(34) & ")"
End Sub
After, I tried using an Input box instead
Dim mainwb As Workbook
mainwb = InputBox("Please enter the name of the workbook, including file extension")
But that's giving me a:
"Runtime error '91': Object variable or With block variable not set".
I have no idea what it wants from me, and I'd really appreciate any help!
To get the name of the workbook, indicated with .GetOpenFileName, you may split once the big string through / and then get the last item. Then, split again by .xls and take the 0th item. With 1 line this 2 operations look like this:
Sub TestMe()
Dim filePath As String
filePath = Application.GetOpenFilename("Microsoft Excel Files, *.xls*")
Dim nameOfWb As String
'do not do this at production, but split it to variables:
nameOfWb = Split(Split(filePath, "\")(UBound(Split(filePath, "\"))), ".xls")(0)
Debug.Print nameOfWb
End Sub
Application.GetOpenFilename("Microsoft Excel Files, *.xls*") returns a string of the workbook path. And Workbooks() needs a workbook name, which is already opened.
Try this:
Sub TestMe()
Dim mainwb As Workbook
Set mainwb = Workbooks.Open(Application.GetOpenFilename("Microsoft Excel Files, *.xls*"))
MsgBox mainwb.Name
End Sub
Application.GetOpenFileName

How to AutoSave as Cell Value with Command Button click in Vba Excel?

Looking to add a second function with the click of the command button in Excel with VBA code - first function populates data from worksheet one (an order form) to a database log in worksheet two. Looking for the second function to be carried out to be an auto-save with cell value from the order form. Thank you!
Private Sub CommandButton1_Click()
Dim OrderDate As String, PONumber As String, Vendor As String, ShipTo As String, SKU As String
Dim R As Long, LastSKURow As Long, NextDBRow As Long, OFrm As Worksheet, DB As Worksheet
Set OFrm = Worksheets("Order Form 1")
Set DB = Worksheets("Database")
OrderDate = OFrm.Range("B3")
PONumber = OFrm.Range("D3")
Vendor = OFrm.Range("B7")
ShipTo = OFrm.Range("D7")
LastSKURow = OFrm.Cells(OFrm.Rows.Count, "F").End(xlUp).Row
For R = 3 To LastSKURow
SKU = OFrm.Range("F" & R).Value
NextDBRow = DB.Cells(DB.Rows.Count, "A").End(xlUp).Row + 1
DB.Range("A" & NextDBRow).Value = OrderDate
DB.Range("B" & NextDBRow).Value = PONumber
DB.Range("C" & NextDBRow).Value = Vendor
DB.Range("D" & NextDBRow).Value = ShipTo
DB.Range("E" & NextDBRow).Value = SKU
Next R
Application.ScreenUpdating = False
Dim Path As String
Dim filename As String
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF,
Path = "C:\PDF\"
filename = OFrm.Range("D3")
OFrm.SaveAs filename:=Path & filename & ".pdf", FileFormat:=xlPDF
OpenAfterPublish:=False
Application.ScreenUpdating = True
End Sub
by auto-save do you mean that it saves the excel workbook? if so you could add something like this...
Application.ActiveWorkbook.Save
If this is not what you are looking for please let me know...
Sorry it took a few days, I've been quite busy.
Based on your previous comment this subroutine that I wrote should resolve your problem. I chose to save the file as a pdf with the assumption that you've set a print area to your form. I chose a pdf because you stated it was an order form and the assumption is that the form will not be edited later. I opted to it because it was a form and there may be some calculated fields attached to another sheet which would not work if you detached the worksheet. If however you decide that you just want a copy of the worksheet I've included the code for it as well. All you need to do is fill in the areas with the comments and attach this function to a command button :). Please let me know if you would like additional information about how to do this.
For the pdf function you can see the information here: https://msdn.microsoft.com/en-us/vba/excel-vba/articles/workbook-exportasfixedformat-method-excel
For the Save As information you can see the information here: https://msdn.microsoft.com/en-us/vba/excel-vba/articles/worksheet-saveas-method-excel
Public Sub savefile()
Dim wb As Workbook
Dim ws As Worksheet
Dim rngfilename As Range
Dim strSavePath As String
'assumptions:
'you are saving the file to a fixed location and the name of the file within the range is continually changing
'you have set the print areas
Set wb = Application.ActiveWorkbook
Set ws = wb.ActiveSheet
Set rngfilename = ws.Range("A1") 'the range that contains your filename
strSavePath = "C:/" 'the location that you would like to save your file
'ensure that there is a value within the filename field declared above
If rngfilename.Value = "" Or Len(rngfilename) = 0 Then
MsgBox "You have not entered a filename"
Exit Sub
End If
'if you do not have print areas set ignore print areas to true in the function bellow
ws.ExportAsFixedFormat xlTypePDF, strSavePath & rngfilename.Value, xlQualityStandard
'for the save as function
'ws.SaveAs strSavePathe & rngfilename.Value
End Sub

Excel VBA: Copy data from multiple passwordprotected workbooks in a folder into one worksheet in another workboo

I have written a code that opens a password protected workbook in a folder, copy some values out of it and paste the values in active woorkbook. This works fine.
My problem is that I have 16 password protected files in this folder, and I need a loop that does the same thing with every file. Below you can find the code, and I think all my problems should be properly explained with comments inside the code. Please ask if anything is unclear. In advance, thanks for any help!
Code:
Sub Bengt()
Dim sPath As String
Dim vFolder As Variant
Dim sFile As String
Dim sDataRange As String
Dim mydata As String
Dim wb As Workbook
Dim WBookOther As Workbook
Dim myArray As Variant '<<does the list of passwords have to be array?
sPath = ThisWorkbook.Path & Application.PathSeparator
sDataRange = "Budsjett_resultat'!E2" '<<every file I want to open has data in this sheet and range
sFile = "BENGT.xlsm" '<< how to make sFile be every file in folder?
' here I want a loop that opens every woorkbook in the folder M::\SALG\2016\Budsjett\
Set WBookOther = Workbooks.Open(sPath & sFile, Password:="bengt123")
' all passwords starts with filename + three numbers after as you can see
' here I want to make excel find the password out of a list of passwords in range B100:B116
mydata = "='" & sPath & "[" & sFile & "]" & sDataRange
'mydata = "='M:\SALG\2016\Budsjett\Bengt.xlsmBudsjett_resultat'!E2:E54" '<< change as required
'link to worksheet
With ThisWorkbook.Worksheets(1).Range("T2:T54")
'in this case I want the loop to find "BENGT"(which is the filename) in cell T1, and paste the values in range T2:T54.
'For the other files, I want the loop to find the filename (of the file it opened) in row 1,
'and paste the values in range ?2-?54 at the column with the same name as the filename
.Formula = mydata
.Value = .Value
WBookOther.Close SaveChanges:=False
End With
End Sub
For the password array I have tried following code:
Sub passord()
Dim myArray As Variant
myArray = ThisWorkbook.Worksheets(1).Range("B100:B116")
On Error Resume Next 'turn error reporting off
For i = LBound(myArray, 1) To UBound(myArray, 1)
Set wb = Workbooks.Open("M:\SALG\2016\Budsjett\BENGT.xlsm", Password:=myArray(i, 1))
If Not wb Is Nothing Then bOpen = True: Exit For
Next i
End Sub
I have tried to implement the last sub into the first sub, but I can't figure out how to make it work.

vba: saveas in xlsm fileformat without changing the active workbook

I have the following code which makes copies of the active workbook and gives each copy a different name. It works well, BUT I really need the original worksheet from which the code is run to stay active.
If I use the SaveCopyAs function instead, the copied files do not have the correct file format (.xlsm), and you cannot specify the file format as a parameter as in the saveAs function.
http://msdn.microsoft.com/en-us/library/bb178003%28v=office.12%29.aspx
http://msdn.microsoft.com/en-us/library/office/ff841185%28v=office.15%29.aspx
Sub makeCopies()
Dim name As Range, team As Range
Dim uName As String, fName As String, fFormat As String
Dim location as string, nName as string
location ="c:\test\"
nName = "Test - Team "
Set team = Names("Team").RefersToRange
For Each name In team
uName = nName & name.Value
fName = location & uName
fFormat = ThisWorkbook.FileFormat
ActiveWorkbook.SaveAs FileName:=fName, FileFormat:=fFormat
Next name
End sub
The best I can think of is to first make the copies with saveCopyAs and then access each file, save it in the correct file format with saveAs and then close it, but that means double work, and I would really hate to do that. Is there a smarter way?
This works form me. SaveCopyAs saves the workbook in the exact same format.
Sub makeCopies()
Dim name As Range, team As Range
Dim uName As String, fName As String, tempname As String
Dim location As String, nName As String
location = "C:\Test\"
nName = "Test - Team "
Set team = ThisWorkbook.Names("Team").RefersToRange
For Each name In team
uName = nName & name.Value
fName = location & uName & "." & _
Split(ThisWorkbook.FullName, ".") _
(UBound(Split(ThisWorkbook.FullName, ".")))
ThisWorkbook.SaveCopyAs fName
Next name
End Sub
Is this what you're trying? Tried and tested.

Resources