I want to open a new workbook, and run some macro inside, at the end will paste the result to the new workbook.
I tried different method to reference other workbooks path because I need the data inside, however, I cant do it correctly. Below is my coding:
Sub stepTen()
Dim wbLinelist As String, wsLinelist As String
wbLlinelist = "C:\Users\abc\Excel\trial\ppp.xlsx"
wsLinelist = "Sheet1"
Dim llStyle As Long
Dim colllStyle, As String
With Workbooks(wbLlinelist).Worksheets(wsLinelist)
llStyle = Application.Match("fire", .Rows(1), 0)
colllStyle = Split(Cells(1, llStyle).Address, "$")(1)
End With
End Sub
Dim colllStyle, As String is no valid syntax remove the comma.
Here Cells(1, llStyle).Address it is not specified in which workbook and worksheet the Cells object is meant to be. It should start with a dot .Cells(…) if you want it to use the With statement or you must specify a workbook/worksheet.
If Application.Match("fire", .Rows(1), 0) does not match it returns an error. So you must check if it matched or errored using the IsError function:
If Not IsError(llStyle) Then
'split
Else
'error message
End If
And finally your main issue is that you cannot use a full path "C:\Users\abc\Excel\trial\ppp.xlsx" in Workbooks(wbLlinelist). You must open a workbook using the Workbooks.Open method before you can access it.
Dim MyOpenWb As Workbook
Set MyOpenWb = Application.Workbooks.Open(FileName:=wbLlinelist) 'you might want to open it read only and set the parameter ReadOnly:=True
With MyOpenWb.Worksheets(wsLinelist)
'your code
End With
Don't forget to close the workbook in the end:
MyOpenWb.Close SaveChanges:=False
Related
I'm currently using a fixed file name in my code however I'd like to replace this fixed name with the value of a particular cell
I've looked extensively across threads to no luck - I'm quite new to coding so I've found similar issues but nothing I'm able to apply to my coding or adapt for exactly my needs
I've tried using
Set wbBook2 = Workbooks(wsSheet1_1.Range("O35").Value)
and a few other similar steps but to no avail
Dim wbBook1 As Workbook
Dim wsSheet1_1 As Worksheet
Dim wsSheet1_2 As Worksheet
Dim wbBook2 As Workbook
Dim wsSheet2_1 As Worksheet
Set wbBook1 = Workbooks("Main File.xlsm")
Set wsSheet1_1 = wbBook1.Worksheets("Example1")
Set wsSheet1_2 = wbBook1.Worksheets("Example2")
Set wbBook2 = Workbooks("Look Up File.xlsm")
Set wsSheet2_1 = wbBook2.Worksheets("Example3")
The above allows me to use 'wbBook2.Activate' to switch to the workbook where the data is located & take the necessary actions however I'd like to be able to change from using "Look Up File.xlsm" to cell O35 on wsSheet1_1.
Currently I'm just ensuring my look-up file has the same name as is noted in the code but this would obviously lead to failure if this is accidentally re-named or a user titled this LookUp File (omitting the space) for example.
Note that 'wbBook2' will already be open when this code is used & the file name can change. The user separately defines the full file path & name (including .xlsm) which is then opened in a separate macro that needs to remain separate
It's safer to loop through Workbooks and look for a match
Private Function set_wb(ByVal toName As String) As Workbook
' Function set_wb(<String>), returns Workbook Object on match.
' - if no match found, return Nothing
' - invokation example: Set wb1 = set_wb("Book1")
Dim wb As Workbook
For each wb in Application.Workbooks
If wb.Name = toName Then
Set set_wb = wb ' wb found
Exit Function
End If
Next wb
Set set_wb = Nothing ' wb not found
End Function
And would be invoked in your case the following way:
Set wbBook2 = set_wb(wsSheet1_1.Range("O35"))
How to import a Sheet from an external Workbook AND use the Filename (WITHOUT the .datatype at the end) as the new Worksheet name?
The part with WITHOUT the .datatype at the end I meant because I could split the filename from the file path with UBound, but when I try to do that with the filename and the filetype at the end, it doesn't work and gives me an error. Perhaps i dont understand ubound
well enough.
I found this Sub somewhere here on the forum.
But I don't want to import any sheet except the sheet which has the same name as the file itself. So I am not even sure if you need to specify the sheet name.
So I have this Excel file with VBA macros. And the Sheet is called Blank (Since I can't have an excel file without a sheet inside it) and
I have a Userform button where I browse for the file first, and the sheet there should be imported to my Excel File and delete the Blank sheet and import the new EXTERNAL sheet.
Also, it should import ANY Sheet from the file path. Because the names will always be different.
And also, how do I import the data as csv?
I am googling but I don't see what exactly causes it to be imported as csv at other peoples solutions.
Sub ImportSheet()
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook, wbBk As Workbook
Dim vfilename As Variant
Dim wsSht As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Comma Separated Value, *.csv", Title:="Open Workbook")
If sImportFile = "False" Then
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile
Set wbBk = Workbooks(sFile)
With wbBk
If SheetExists("GaebTesten.g42_2") Then
Set wsSht = .Sheets("GaebTesten.g42_2")
wsSht.Copy Before:=sThisBk.Sheets("Start")
Else
MsgBox "There is no sheet with name :US in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function
this is my second post here on stack overflow, and my first question was very dumb, and when I asked my first question, it was my 2nd hour with vba.
I think I am at about 30 hours now and I've learned a lot.
Question: I am doing this Excel Macro in VBA with userform too now. But mostly I google how to do what and I try to implement it WHILE understanding it, I don't just copy and paste code. Often I just do line by line and test it out.
BUT... how do you guys remember all that?
If I had to program the same thing again right now, I won't know how to, because I know how a syntax works, but I wouldn't know which syntax and stuff to actually use to achieve the desired effect...
Does it come from repeating the same things = experience?
Or how do you acquire the abilities to code without googling almost every single thing? When watching youtubers live streaming how they code something, they never look it up on the internet....
Let me present you a different way than pure string manipulation:
Set a new reference to Microsoft Scripting Runtime. This will enable the Scripting namespace. With it you can do things like the following:
sImportFile = "C:\StackFolder\PrintMyName.xlsx"
With New Scripting.FileSystemObject
Debug.Print .GetBaseName(sImportFile)
' Outputs "PrintMyName"
Debug.Print .GetExtensionName(sImportFile)
' Outputs "xlsx"
Debug.Print .GetFileName(sImportFile)
' Outputs "PrintMyName.xlsx"
Debug.Print .GetDriveName(sImportFile)
' Outputs "C:"
Debug.Print .GetParentFolderName(sImportFile)
' Outputs "C:\StackFolder"
End With
You can build a little helper function to give you the part of the file name you need:
Public Function GetFilenameWithoutExtension(ByVal filename as String) as String
With New Scripting.FileSystemObject
GetFilenameWithoutExtension = .GetBaseName(filename)
End With
End Function
and call it: sFile = GetFilenameWithoutExtension(sImportFile)
Regarding the interesting use of UBound in your subroutine, you could even get the filename (without extension) that way - assuming it doesn't contain additional dots:
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
SplitName = Split(sFile, ".")
FilenameWithoutExtension = SplitName(UBound(SplitName)-1)
Extension = SplitName(UBound(SplitName))
These are, however, purely academical thoughts and I wouldn't recommend doing it this way.
Here are two ways to extract the workbook name without the file extension. Here I am removing the extension .xlsx. If the extension is constant, you can just hard code it. If not, you can use wildcards also
MsgBox Left(wbBk.Name, Len(ThisWorkbook.Name) - 5)
MsgBox Replace(wbBk.Name, ".xlsx", "")
You can refer to the sheet with the same name as the workbook by using something like
Sheets(Left(wbBk.Name, Len(ThisWorkbook.Name) - 5).Copy
Sheets(Replace(wbBk.Name, ".xlsx", "").Copy
You can use InstrRev. It is efficient as starts from the end of the string which is where the extension is located.
Left$(wbBk.Name, InStrRev((wbBk.Name, ".") - 1)
I am looking at building a master workbook which receives a monthly dump of data for all Cost Centres which will then populate a large number of worksheets within the workbook, and which then need to be split off and sent out to service heads. A service head will receive a selection of worksheets based on the first 4 characters of the sheet name (although this may change in due course).
eg 1234x, 1234y, 5678a, 5678b will produce two new workbooks named 1234 and 5678 with two sheets in each.
I have cobbled some code from various forum to create a macro that will work through a hard coded array defining the service head 4 character codes and create a series of new workbooks. And which seems to work.
However.. I also need to include the main data dump sheet within the source file (called "data") with the the array of files being copied over so that the links remain with the data sheet being copied over. If I write a line to copy over the data sheet separately, the new workbook still refers back to the source file, which service heads do not have access to.
So main question is: how can I add the "data" tab into the Sheets(CopyNames).Copy code so it is copied over with all the other files in the array at the same to keep the links intact?
Second question is if I decide it is the first two characters of the worksheet define the sheets that relate to a service head, how do I tweak the split/mid line of code - I've trialled around but am getting tied up in knots!
Any other tips to make the code more elegant much appreciated (there may be quite a long list of service head codes and I am sure there is a better way of creating a list for the routine to loop through)
Sub Copy_Sheets()
Dim strNames As String, strWSName As String
Dim arrNames, CopyNames
Dim wbAct As Workbook
Dim i As Long
Dim arrlist As Object
Set arrlist = CreateObject("system.collections.arraylist")
arrlist.Add "1234"
arrlist.Add "5678"
Set wbAct = ActiveWorkbook
For Each Item In arrlist
For i = 1 To Sheets.Count
strNames = strNames & "," & Sheets(i).Name
Next i
arrNames = Split(Mid(strNames, 2), ",")
'strWSName =("1234")
strWSName = Item
Application.ScreenUpdating = False
CopyNames = Filter(arrNames, strWSName, True, vbTextCompare)
If UBound(CopyNames) > -1 Then
Sheets(CopyNames).Copy
ActiveWorkbook.SaveAs Filename:=strWSName & " " & Format(Now, "dd-mmm-yy h-mm-ss")
ActiveWorkbook.Close
wbAct.Activate
Else
MsgBox "No sheets found: " & strWSName
End If
Next Item
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub CopySheets()
With ThisWorkbook
Dim SheetIndex As Long
Dim ValidSheetNames() As String
ReDim ValidSheetNames(1 To .Worksheets.Count)
' Build a 1 dimensional array called ValidSheetNames, which contains every sheet in the master workbook other than DEDICATEDSHEET. '
Dim ws As Worksheet
For Each ws In .Worksheets
If ws.Name <> "DEDICATEDSHEET" Then
SheetIndex = SheetIndex + 1
ValidSheetNames(SheetIndex) = ws.Name
End If
Next ws
ReDim Preserve ValidSheetNames(1 To SheetIndex)
' Read all ServiceCodes into a 1-dimensional array '
Dim ServiceHeadCodes As Variant
ServiceHeadCodes = Application.Transpose(.Worksheets("DEDICATEDSHEET").Range("CCLIST[CC]").Value2)
Dim CodeIndex As Long
' Now loop through each ServiceHeadCode '
For CodeIndex = LBound(ServiceHeadCodes) To UBound(ServiceHeadCodes)
' Put all sheet names which contain the current ServiceHeadCode into an array called SheetsToCopy '
Dim SheetsToCopy() As String
SheetsToCopy = Filter(ValidSheetNames, ServiceHeadCodes(CodeIndex), True, vbTextCompare)
' Check if SheetToCopy now contains any sheet names at all. '
If UBound(SheetsToCopy) > -1 Then
' Add the name of the Data sheet to the end of the array '
ReDim Preserve SheetsToCopy(LBound(SheetsToCopy) To (UBound(SheetsToCopy) + 1))
SheetsToCopy(UBound(SheetsToCopy)) = "Data"
Dim OutputWorkbook As Workbook
Set OutputWorkbook = Application.Workbooks.Add
' Copy all sheets which are in SheetToCopy array to newly created OutputWorkbook '
.Worksheets(SheetsToCopy).Copy OutputWorkbook.Worksheets(1)
' Delete the default Sheet1, which should be at the end as copied sheets were inserted before it. '
' But suppress the Are you sure you want to delete this sheet.. message. '
Application.DisplayAlerts = False
OutputWorkbook.Worksheets(OutputWorkbook.Worksheets.Count).Delete
Application.DisplayAlerts = True
' Re-enable alerts, as we want to see any other dialogue boxes/messages
' Not providing a full directory path below means OutputWorkbook will be saved wherever Thisworkbook is saved.'
OutputWorkbook.SaveAs Filename:=ServiceHeadCodes(CodeIndex) & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsx", FileFormat:=51
OutputWorkbook.Close
Else
MsgBox "No sheets found: " & ServiceHeadCodes(CodeIndex)
End If
Next CodeIndex
End With
End Sub
Untested and written on mobile, sorry for bad formatting.
This approach proposes that you store all service head codes in a 1-column Excel table on a dedicated sheet that is referred to via Excel table nomenclature (which might be easier than ArrayList.Add for each new service head code).
I assume code is stored in master workbook ('thisworkbook'), which might not be true.
You could modify the serviceheadcodes table directly on the spreadsheet itself, if you later decide that SheetsToCopy will be determined by first 2, 3 or X characters -- or you could modify array itself with left$() function.
Hope it works or gives you some ideas.
Edit: This is my sheet and table layout (which I assume matches yours).
And this is what the code above gives me on my computer.
I get the error 'Subscript Out of Range' when I run the following code; debug points me to the last line:
Dim SrcBook As Workbook
Dim TrgBook As Workbook
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim Sheet_Name As String
Workbooks.Open (CalendarFile)
Sheet_Name = MonthName(Month(SrcSheet.Cells(SrcRow, "D").Value), False)
MsgBox ("Sheet_Name Value is: " & Sheet_Name)
Set TrgSheet = Workbooks(CalendarFile).Worksheets(Sheet_Name)
I have repeatedly verified that CalendarFile is a valid file name (I use the full path filename). Sheet_Name is also the valid name of a sheet in that Workbook. I get a similar error if I try to access the worksheets via numeric indexing [ie, Workbooks(CalendarFile).Worksheets(11) vs Workbooks(CalendarFile).Worksheets(November)]. The MsgBox call verifies that I'm feeding the WorkSheets() method the proper sheet name.
Lastly, ScrRow is properly defined - I am able to use this code to manipulate target WorkSheets in the same WorkBook as the macro is called from in toy/testing applications, but for some reason it is failing when I try to manipulate target WorkSheets in other (open) WorkBooks.
Any help would be greatly appreciated! Thank You!
If CalendarFile is a valid filename, that's your issue. The index you need for Workbooks() is the Workbook.Name, not its file path. For example, if CalendarFile was C:\Foo\Bar.xlsx, you need to use Bar.xlsx.
As for the explanation above, it really doesn't matter because you should really just grab a the reference that Workbooks.Open returns and just use that:
Set TrgBook = Workbooks.Open(CalendarFile)
Sheet_Name = MonthName(Month(SrcSheet.Cells(SrcRow, "D").Value), False)
MsgBox ("Sheet_Name Value is: " & Sheet_Name)
Set TrgSheet = TrgBook.Worksheets(Sheet_Name)
Found the solution, at least to this problem:
Workbooks.Open (CalendarFile)
Requires the full-path-name of the file to open, but further references to the file require just the file name - without any of the path attached. That is,
Workbooks(file_name_without_path.xlsx).Worksheets(Sheet_Name)
This is extremely annoying and should be fixed.
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.