I have 2 different workbooks with a set of parameters, e.g. car parts number, sales prices, etc. The 2 different workbooks will always have the same car parts numbers but they are not in order. So I was thinking of using a vlookup to match the parameters on one workbook to the other related to the respective parts' numbers.
Thus, I used vlookup to perform this task. It works, but I want to implement this using a macro, so I would not need to manually do the vlookup every time. Is it possible to create such a macro given that the workbooks (file names) would be different every time?
I actually tried recording the macro and the vlookup records the parameters it needs relating to the file name.
EDIT: code from comment:
Sub Macro1()
ActiveCell.FormulaR1C1 = "=VLOOKUP('[TI_DBP_effective_06 May 2013.xls]NON SLL'!C1,'[TI_DBP_effective_06 May 2013.xls]NON SLL'!C1:C3,3,FALSE)"
Range("I1").Select Selection.AutoFill Destination:=Range("I1:I9779")
Range("I1:I9779").Select
End Sub
Try something like this. You will have to place this macro in your Personal macro workbook, so that it is available all the time, no matter what workbooks are open. It will prompt you for two files, and then open them, and should insert the formula. Let me know if it gives you any trouble since I am not able to test it right now.
NOTE: This looks up the value one column to the LEFT of the cell you select, and then looks in columns 1:3 of the other file. Modify as needed.
Sub Macro1()
Dim file1 As String
Dim file2 As String
Dim wbSource As Workbook
Dim wbLookup As Workbook
Dim startRange As Range
file1 = Application.GetOpenFilename(Title:="Select the file to update")
If Len(Dir(file1)) = 0 Then Exit Sub
file2 = Application.GetOpenFilename(Title:="Select the LOOKUP file")
If Len(Dir(file2)) = 0 Then Exit Sub
Set wbLookup = Workbooks.Open(file2)
Set wbSource = Workbooks.Open(file1)
On Error Resume Next
Set startRange = Application.InputBox("Select the first cell for the formula", "Autofill VLOOKUP", Type:=8)
On Error GoTo 0
If Not startRange Is Nothing Then
Application.Goto startRange
startRange.FormulaR1C1 = "=VLOOKUP('[" & wbSource.Name & "]NON SLL'!RC[-1],'[" & wbLookup.Name & "]NON SLL'!C1:C3,3,FALSE)"
startRange.AutoFill Destination:=startRange.End(xlDown)
End If
End Sub
Related
So I am trying to write a Macro for Excel, that adds 2 worksheets from an excel file to a new one.
Therefore, I try this:
Sub addfile()
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set sheet1 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page1.xltx")
Set sheet2 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page2.xltx")
End Sub
When I test it, it imports the first page, but the 2nd page gives me a Runtime error 1004.
Why does this happen?
And is there another way to get 2 sheets from one excel file to another via vba?
Much to my surprise this version of your code actually worked for me.
Sub addfile()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Template1.xltx")
Set Sheet2 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Book2.xlsx")
Debug.Print Sheet1.Name, Sheet2.Name
End Sub
The reason for my surprise is that Sheet1 and Sheet2 are the default CodeName for the first and second worksheets in any workbook. Therefore there is a conflict of naming between the Sheet1 in the workbook and the Sheet1 you declare which should come to the surface not later than Debug.Print Sheet1.Name. In fact, it may have. I didn't check which name was printed. But the code didn't crash. Since it crashes on your computer, perhaps you have an older version of Excel. Try to stay clear of variable names that Excel also uses. Or there is something wrong with the path & file name, which is hard to tell in that syntax and therefore kept me fooled for quite some time too.
In fact, I discovered the above only after finding out that my Desktop was on OneDrive and not before I had written the function below which is designed to avoid the use of Sheets.Add. It also has some extras such as being able to specify the sheet to take from the template (you could have one template with 2 or more sheets). You can specify an index number or a sheet name. And the function will give a name to the copy, too, if you specify one.
Private Function AddWorksheet(ByVal Template As String, _
TabId As Variant, _
Optional ByVal TabName As String) As Worksheet
Dim Wb As Workbook
Dim Path As String
Dim FileName As String
Set Wb = ThisWorkbook ' change to suit
' make sure the path ends on "\"
Path = "C:\Users\Helge\AppData\Roaming\Microsoft\Templates\"
With Workbooks.Open(Path & Template)
.Sheets(TabId).Copy After:=Wb.Sheets(Wb.Sheets.Count)
.Close
End With
Set AddWorksheet = ActiveSheet
If Len(TabName) Then ActiveSheet.Name = TabName
End Function
You can call the function from a sub routine like this:-
Sub AddWorksheets()
Dim Tab1 As Worksheet
Dim Tab2 As Worksheet
Application.ScreenUpdating = False
Set Tab1 = AddWorksheet("Page1.xltx", 1, "New Tab")
Set Tab2 = AddWorksheet("Page2.xltx", "Sheet1", "Another new Tab")
Application.ScreenUpdating = True
End Sub
Please observe the difference between the two function calls.
I am trying to get a database from Workbook B to autofilter using some input from Workbook A. I am building the macro in Workbook A.
I have the following:
Workbook A - Document were you start working
Worrkbook B - Database, the final objective of this code is to import some info from Workbook B to Workbook A
I need the following:
By double clicking in a column from workbook A, workbook B should open (done)
The clicked value from workbook A will be saved as a variable, lets call it input_db (done)
Workbook B will autofilter based on input_db (not done, help required here!)
The required data is selected from workbook B and imported to workbook A, preferably with a double click as well (not done yet, but if you have any suggestion for this, Ill be gratefull ;))
The process should be repeated several times in a row.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim input_row, input_column As Integer
Dim input_db As String
Dim wbB, wbA As Workbooks
If Not (Application.Intersect(ActiveCell, [Links]) Is Nothing) Then 'Links is the name of the range where I need the code to be active
If ActiveCell.Value <> "" Then
input_row = ActiveCell.row
input_column = ActiveCell.Column
input_db = ActiveCell.Value
Set database = Workbooks.Open("Workbook B location")
ActiveWorkbook.ActiveSheet.Range("A9").AutoFilter Field:=1, Criteria:=input_db ' This bit doesnt work as expected
End If
End If
End Sub
As I can see you are using the wrong format of Autofilter. Try this line after amending as per your need. Autofilter takes in Criteria1 not Criteria.
ActiveWorkbook.ActiveSheet.Range("A9").AutoFilter Field:=1, Criteria1:=input_db
Also you can find more about Autofilter here: Link
Let us know if it still doesn't work.
Edit 2 :
You will have to open a input box and select the cell. You can follow the This Link for that.
I'm still reasonably new to VBA and feel I'm punching a little above my weight, so hopefully someone can help.
I need to issue a spreadsheet to people in my company which they can fill out and send it back. This needs to be done multiple times, so I have tried to automate this as much as possible. The source data is pasted in an "input" tab - this is then pivoted by user and input into a template tab. I can select any user and run a macro which does this and exports the filled out template to a new workbook.
In this template tab, I have dependent drop-down lists, which I have done by data validation - this relies on named ranges from the "coding" tab, which is also exported. One named range shows a list of values, and the other indexes over this and matches it to the required cell, to ensure only valid combinations are shown.
My issue is that the new workbook must not contain any links to the master - it should function completely in its own right. However, something is going wrong with the data validation/named ranges. Either some named ranges are being deleted (I know which bit of code is doing that but without it you get prompted to update links) or the data validation formula links back to the original workbook and doesn't work. I cannot find another way of achieving what I need without this particular data validation set up, so I need to try and adjust my macro to cater for this.
Is it possible to simply copy the template and coding tabs, with all the data validation, to a new workbook and break all links to the original, so that there are no startup prompts and the drop-downs all work?
Sub Copy_To_New_Workbook()
Dim wb As Workbook
Dim name As String
Dim ExternalLinks As Variant
Dim x As Long
Dim strFolder As String, strTempfile As String
name = Worksheets("Control").Cells(14, 7).Value
Let FileNameIs = Range("Filepath").Value & Range("FileName").Value
Set wb = Workbooks.Add
ThisWorkbook.Worksheets("Coding").Copy Before:=wb.Sheets(1)
ActiveSheet.name = "Coding"
ThisWorkbook.Worksheets("Transactions").Copy Before:=Worksheets("Coding")
ActiveSheet.name = "Transactions"
With ActiveSheet.UsedRange
.Value = .Value
End With
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
For x = 1 To UBound(ExternalLinks)
wb.BreakLink name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
Next x
Dim objDefinedName As Object
For Each objDefinedName In wb.Names
If InStr(objDefinedName.RefersTo, "[") > 0 Then
objDefinedName.Delete
End If
Next objDefinedName
On Error GoTo 0
wb.SaveAs Filename:=FileNameIs, FileFormat:=52
ActiveWorkbook.Close
End Sub
I have two workbooks, with same sheets name (but in different order), and I'd like to copy info of all of the sheets of one workbook, and pasting that info in the respective sheet of the other workbook (matching sheet names). I feel like this code is on track, but maybe there is a more efficient or cleaner way to do this. Code is working, but it says a warning like " there's a big amount of data in the windows clipboard... etc... "
Sub ActualizarNoticias()
Dim aw As Workbook
Dim y As Workbook
Set aw = Application.ActiveWorkbook
Set y = Application.Workbooks.Open("G:\Estudios\Biblioteca\Mercado Accionario Chileno\BBDD Oficial.xlsm")
For i = 1 To aw.Sheets.Count
For j = 1 To y.Sheets.Count
If aw.Worksheets(i).Name = y.Worksheets(j).Name Then
y.Worksheets(j).Range("A3").Copy
aw.Worksheets(i).Range("A100").PasteSpecial
End If
Next j
Next i
y.close
' ActualizarNoticias Macro
'
'
End Sub
I am not sure how much data you intend to copy, or where in the target workbook you want to copy to, but the code you posted only copies one cell (A3) and copies it into the target workbook in cell A100. I gather your code is only an example, because surely the warning would not come for copying a single cell. It would help to have your actual ranges, and exact warning message, but as you said, it's working. Are you getting the message when you run the code, or when you exit the workbook? If the latter (as I suspect), then you can simply clear the clipboard at the end of your code:
Application.CutCopyMode = False
You can also eliminate the second loop with a little trickery:
Set sh = Nothing
On Error Resume Next
Set sh = y.Worksheets(aw.Worksheets(i).Name)
On Error GoTo 0
If TypeName(sh) <> "Nothing" Then
....
End If
My entire subroutine looks as follows:
Sub CopyWorkbook()
Dim aw As Workbook
Dim y As Workbook
Dim sh As Worksheet
Set aw = Application.ActiveWorkbook
Set y = Application.Workbooks.Open("C:\work\fusion\expenseTypes.xls.xlsx")
For i = 1 To aw.Sheets.Count
Set sh = Nothing
On Error Resume Next
Set sh = y.Worksheets(aw.Worksheets(i).Name)
On Error GoTo 0
If TypeName(sh) <> "Nothing" Then
sh.Range("A:C").Copy aw.Worksheets(i).Range("A1")
End If
Next i
Application.CutCopyMode = False
End Sub
I think this is the most efficient way to do it. My sample code above copies entire columns (A through C), which preserves column formatting, so that it's not necessary to re-adjust your new workbook for the column widths.
I have a pivot table in excel which looks like this:
Team Doc 1 Doc 2 Grand Total
Team A 13 12 25
Team B 8 7 15
Team C 32 5 37
Grand Total 53 24 77
I have already written a piece of VBA which will format any drill down sheets for printing (Workbook_NewSheet(ByVal Sh As Object)). However, as I'm trying to make this as user friendly as possible, I'd really like to be able to use vba to automatically rename any worksheets generated from the pivot table. However, I'm not sure how to do it as the content of each worksheet will be different depending on where the user clicks (i.e. if the user clicks in Team A Doc 1 Total then the sheet should be named 'Team A Doc 1' but if the user clicks in Grand Total row of Doc 2 then the sheet should be named 'Grand Total Doc 2') - I think there are something like 15 different worksheet names that could occur which is why I'm guessing the worksheet defaults to Sheet1! I'm thinking that a name could be generated by using offset to pick up the team name or the column name based on the active cell but I'm not really sure where to start so any suggestions/assistance would be greatly appreciated!
Thanks
I wish I could comment, but I can't yet, as I have not enough rep points! (Had to restart my account!)
I can suggest that you record a macro while you do a drill down on any given data point manually, and see how the recorded vba code looks. I would think from there you can configure your code to base the name of your worksheet on some element of the recorded code.
Since, I wanted this to be a comment, I will delete this if it's not helpful.
Update To Your Newly Posted Answer:
To check if the sheet already exists when a user drills down, you can check if the sheet existss after you get the sheet name to and if it does, select it, rather than creating a new one. Otherwise, you create it.
See this code for that:
Private Sub Workbook_NewSheet(ByVal sh As Object)
Application.ScreenUpdating = False
Dim shtCur As Worksheet
Set shtCur = ActiveSheet
Sheets("DQ Summary").Select
RN = ActiveCell.Row
CN = ActiveCell.Column
SheetName = Cells(RN, 2).Value & " - " & Cells(9, CN).Value
If SheetExists(SheetName) Then
Worksheets(SheetName).Select
Else
shtCur.Move _
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
shtCur.Name = "SheetName"
End If
Application.ScreenUpdating = True
End Sub
Function SheetExists(wsName As String, Optional wb As Workbook = Nothing) As Boolean
SheetExists = False
Dim WS As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set WS = wb.Worksheets(wsName)
On Error GoTo 0
If Not WS Is Nothing Then SheetExists = True
End Function
I've managed to come up with something fairly workable:
Private Sub Workbook_NewSheet(ByVal sh As Object)
Dim RN, CN As Byte
Dim SheetName As String
Application.ScreenUpdating = False
ActiveSheet.Move _
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
'Names the sheet according to the pivot drill
Sheets("DQ Summary").Select
RN = ActiveCell.Row
CN = ActiveCell.Column
SheetName = Cells(RN, 2).Value & " - " & Cells(9, CN).Value
'Identifies if worksheet already exists and replaces it if so.
Application.DisplayAlerts = False
On Error Resume Next
mySheetNameTest = Worksheets(SheetName).Name
If Err.Number = 0 Then
Worksheets(SheetName).Delete
MsgBox "The sheet named ''" & SheetName & "'' already exists but will be replaced."
Else
Err.Clear
End If
Application.DisplayAlerts = True
Sheets(ActiveWorkbook.Sheets.Count).Select
ActiveSheet.Name = SheetName
End Sub
Basically it's added onto the newsheet event - the macro adds the new sheet to the end of the workbook, goes to the pivot table sheet and identifies the column and row names of the active cell (since the column name and row name will always be static I can hard code this in) and then locates the newly added sheet (always at the end of the workbook) and renames it. Unfortunately there's an issue if a user tries to drill on the same data twice (can't have two worksheets with the same name) which I'm hoping to iron out.
Thanks for views/comments.
Edit: Updated code to work around worksheet duplication issue, seems to be doing the trick!