I have a excel file that contain daily order id and I need to get some data from other excel use the order id as index. The source file contain many worksheet that means a listbox with sheet name for selection is required.
The workbook & worksheet used for data source is not fixed and will determine by user, so a listbox for user to select relevant worksheet is required
The workflow is when i call the vba at the daily excel file, a listbox with all sheet name of the source excel file will pop up for select worksheet, then the daily excel file will get data from the source excel base on the order id as index.
Now I have a vba using activeworkbook and activeworksheet to set the lookup range, but I don't think this is a good coding method. Could someone can give me some suggestion?
For the userform code if the strfile is set to an exact file the code is fine, but the source file may be change.
All source files are save in same location, the required source file name is in Range("Z1") of the daily excel file, is it possible the strfile can change base on Range("Z1")?
Please let me know if I can clarify anything for you.
Sub example()
Dim dest_wbk As Workbook
Dim dest_ws As Worksheet
Dim source_wbk As Workbook
Dim source_ws As Worksheet
Set dest_wbk = ThisWorkbook
Set dest_ws = dest_wbk.ActiveSheet
sourcefilename = Range("Z1")
UserForm1.Show
Set source_wbk = ActiveWorkbook
Set source_ws = source_wbk.ActiveSheet
sourcelastrow = source_ws.Cells(Rows.Count, 2).End(xlUp).Row
Set lookuprange = source_ws.Range("A2:E" & sourcelastrow)
dest_lastrow = dest_ws.Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To des_lastrow
ID = dest_ws.Range("D" & i)
dest_ws.Range("K" & i) = Application.VLookup(ID, lookuprange, 3, False)
dest_ws.Range("L" & i) = Application.VLookup(ID, lookuprange, 4, False)
Next i
source_wbk.Close
End Sub
'Below in the code in the userform
Private Sub ListBox1_Click()
Sheets(ListBox1.Value).Activate
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim sh As Worksheet
strfile = ("C:\Documents\" & sourcefilename)
Set wbk = Workbooks.Open(strfile, ReadOnly:=True)
For Each sh In wbk.Sheets
ListBox1.AddItem sh.Name
Next sh
End Sub
You need to change your two variables dest_wbk and dest_ws to something like
In case your destination Workbook is already open
'Change Workbook2.xls to whatever the file is (assuming it is open already)
Set dest_wbk = Workbooks("Workbook2.xls")
'Change SheetName to whatever the sheet name is inside dest_wbk
Set dest_ws = dest_wbk.Sheets("SheetName")
Otherwise, you need to open the workbook
'Change Workbook2.xls to whatever the file is
Set dest_wbk = Workbooks.Open("Workbook2.xls")
'Change SheetName to whatever the sheet name is inside dest_wbk
Set dest_ws = dest_wbk.Sheets("SheetName")
It is up to you, to get those values (Workbook name and Sheet name) from the UserForm, which I believe it shouldn't be a problem for you.
Related
I am trying to figure out how to do this, any guidance would be great.
Setup: I work between 2 workbooks called Master and Daily Input
The Daily Input file contains 10 worksheets, each worksheet = 1 person's name. + 1 worksheet named "Input Template"
The Master workbook contains a bunch of different worksheets for different calculations. + 9 worksheet with the team member's names.
Assume currently there are 9 people in the team.
When new people join or leave the team, they will open / delete worksheets from the Daily Input workbook.
Therefore I want to:
New Team Member added a new worksheet scenario:
If Daily Input have a worksheet that Master does not (except Input Template), then create a new worksheet in Master with the same name. The new worksheet is copied from Output Template that is already in the Master file.
If Master have a worksheet that Daily Input does not (except a few worksheets for calculation), then just prompt a messagebox.
Currently I have written something that extracts all the sheet names from the Daily Input file, and then put it in the Master File but I am not sure how to make use of that...
Maybe load both sheet name lists into an array and compare?
Sub ObtainNameList()
Application.ScreenUpdating = False
Dim WkBk_Input As Workbook
Dim WkBk_Active As Workbook
Dim GetListFName As String
Dim GetListFPath As String
Dim FName As String
Dim FPath As String
Dim i As Integer
Set WkBk_Active = Application.ActiveWorkbook
FPath = WkBk_Active.Worksheets("Menu").Range("B1")
FName = WkBk_Active.Worksheets("Menu").Range("B2")
Set WkBk_Input = Application.Workbooks.Open(FPath & "\" & FName)
WkBk_Active.Worksheets("NameList").Range("A:A").ClearContents
For i = 1 To WkBk_Input.Sheets.Count
WkBk_Active.Worksheets("NameList").Range("A" & i).Value = WkBk_Input.Sheets(i).Name
Next i
WkBk_Input.Close
Application.ScreenUpdating = True
End Sub
This ought to work, but I'm on my phone so can't actually check it:
Sub CheckandCreate()
Dim Fpath As String
Dim Fname As String
Dim master As Workbook
Set master = ThisWorkbook 'assume running in master
Dim daily As Workbook
'set daily path and name here
Set daily = Workbooks.Open(Fpath & "\" & Fname)
Dim ws As Worksheet
For Each ws In daily.Worksheets
Select Case ws.Name
Case "Input Template" 'add ay other sheet names you want to ignore here
Case Else
If SheetNotExist(ws.Name, master) Then
AddSheet (ws.Name)
End If
End Select
Next ws
daily.Close False 'close daily without saving
End Sub
Function SheetNotExist(sheetname As String, where As Workbook) As Boolean
On Error GoTo nope
Dim ws As Worksheet
Set ws = where.Worksheets(sheetname) 'if sheet exists this will work
SheetNotExist = False
Exit Function
nope:
SheetNotExist = True 'will only get here if sheet doesn't exist
End Function
Sub AddSheet(sheetname As String)
Dim ws As Worksheet
ThisWorkbook.Worksheets("Output Template").Copy _ after:=ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count) 'copy to end of workbook
Set ws = ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count) 'new worksheet
ws.Name = sheetname
End Sub
could you please help me out adjusting my macro?
What I have
Selecting different workbooks(wb1,wb2...) via a file explorer dialog
window and listing them in a listbox
Transfering certain data from the selected workbooks to a workbook
template(wb_template) and saving it as a new workbook.
The new workbook contains the data from wb_1, but the structure of
wb_template The User Form Looks like this:
What I need
I need to adjust the way the relevant data from the workbooks is selected("Transfer-data" button). I would need a loop which is going through every sheet of wb_1 and is covering the following:
Look for certain terms in wb_1 and move/rename them to wb_template in specific sheet/column/cell.
Example:
Look for certain terms in wb_1 and just take the value, which is stored in the cell on the right side of it, and move to wb_template in specific sheet/column/cell.
Example:
The steps above should be applied to every sheet of wb_1 and for every sheet should be a new workbook created.
So, at the end of the process I should have a new workbook for every sheet in wb_1.
For example: if wb_1 has 5 sheets, there should be 5 new workbooks created (wb1_1, wb1_2, wb1_3,...).
Here is a simple overview visual showing what I exactly want to achieve with this macro:
My actual code
Transfer Data Button
Sub Transferfile(wbTempPath As String, wbTargetPath As String)
Dim wb1 As Workbook
Dim wb_template As Workbook
Set wb1 = Workbooks.Open(wbTargetPath)
Set wb_template = Workbooks.Open(wbTempPath)
'/* Definition of the value range */
wb_template.Sheets("Sheet1").Range("A2").Value = wb1.Sheets("Sheet1").Range("A2").Value
wb_template.Sheets("Sheet1").Range("A3").Value = wb1.Sheets("Sheet1").Range("A3").Value
wb_template.Sheets("Sheet1").Range("B2").Value = wb1.Sheets("Sheet1").Range("B2").Value
wb_template.Sheets("Sheet1").Range("B3").Value = wb1.Sheets("Sheet1").Range("B3").Value
wb1Name = Left(wb1.Name, InStr(wb1.Name, ".") - 1)
wb_template.SaveAs wb1.Path & "\" & wb1Name & "_New.xlsx"
wb1.Close False
wb_template.Close False
End Sub
Browse File Button - I guess not so relevant for this topic
Private Sub CommandButton1_Click()
Dim fNames As Variant
With Me
fNames = Application.GetOpenFilename("Excel File(s) (*.xls*),*.xls*", , , , True)
If IsArray(fNames) Then .ListBox1.List = fNames
End With
End Sub
Private Sub CommandButton2_Click()
Dim i As Integer
'/* full path to the template file */
Const mytemplate As String = "C:\Users\PlutoX\Desktop\Excel-Folder\wb_template.xlsx"
With Me
With .ListBox1
'/* iterate listbox items */
For i = 0 To .ListCount - 1
'/* transfer the files using the generic procedure */
Transferfile mytemplate, .List(i, 0)
Next
End With
End With
End Sub
Thanks for the help!
Summary:
I need to search for for specific keywords in a sheet of wb1.
I dont know the positions of those keywords
In case a keyword is found - condition1 or condition2 will be applied, depending on the keyword:
Condition 1: if keyword in wb1 = "House_1" then copy/paste keyword in wb2 (specific position -> Sheet2, A3) and rename it to
"House Blue".Result would be: "House Blue" in A3 of Sheet2 in wb2.
Condition 2: if keyword in wb1 = "Number" then copy the value of the adjoining cell to the right of it and paste in wb2 (specific
position -> Sheet3, C5).Result would be: "4" in C5 of Sheet3 in wb2.
So what I want to do is to determine the relevant keywords - and which condition the respective keyword is triggering.
Update:
I dont know the specific sheet, so every sheet in the wb should be checked
Actually, my goal is to have a set of keywords, which have condition 1 or condition 2 assigned, as well as a specific paste-location in wb_template. So, every sheet should be checked according to the set of keywords. A keyword can only have one of the conditions assigned.
If the challenge you are facing is to find a specific word which could be lying anywhere in the workbook you can make use of Excel's inbuilt function "Find" with slight modification.
I will post a sample snippet which does the same. Please modify it accordingly.
Code Snippet: [ Tried & tested ]
Sub FindMyWord()
Dim sht As Worksheet
For Each sht In ThisWorkbook.Sheets 'Change workbook object accordingly
Dim CellWhereWordIs As Range
Set CellWhereWordIs = sht.Cells.Find("Charlie", LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
'Charlie is the word I wanna find. Change parmeters accordingly
If Not CellWhereWordIs Is Nothing Then
'Do something here
MsgBox "Word found in: " & sht.Name & "/" & CellWhereWordIs.Address
Else
MsgBox "Word not found in " & sht.Name, vbExclamation
End If
Next
End Sub
I think you just need to wrap your code into a loop going through all the worksheets.
I also recommend to use a bit more descriptive variable names: wb1 is not very descriptive but if you change it to wbSource it is very clear that this is the workbook where the data comes from.
Finally I recommend to use Application.PathSeparator instead of "\" to make it independent form your operating system (eg. MacOS uses "/" instead of "\").
Option Explicit
Public Sub TransferFile(TemplateFile As String, SourceFile As String)
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(SourceFile) 'open source
Dim wbTemplate As Workbook
Dim NewWbName As String
Dim wsSource As Worksheet
For Each wsSource In wbSource.Worksheets 'loop through all worksheets in source workbook
Set wbTemplate = Workbooks.Open(TemplateFile) 'open new template
'/* Definition of the value range */
With wbTemplate.Worksheets("Sheet1")
.Range("A2").Value = wsSource.Range("A2").Value
.Range("A3").Value = wsSource.Range("A3").Value
.Range("B2").Value = wsSource.Range("B2").Value
.Range("B3").Value = wsSource.Range("B3").Value
End With
NewWbName = Left(wbSource.Name, InStr(wbSource.Name, ".") - 1)
wbTemplate.SaveAs wbSource.Path & Application.PathSeparator & NewWbName & "_New.xlsx"
wbTemplate.Close False 'close template
Next wsSource
wbSource.Close False 'close source
End Sub
Is it possible to save into another workbook instead of same workbook. we are making a master workbook. daily we are updating data, once updated by pushing button need to copy in to master workbook with sheet name as current date.
below code working for copying into same work book into sheet2
Private Sub CommandButton1_Click()
On Error GoTo Err_Execute
Sheet1.Range("A1:J75").Copy
Sheet2.Range("A1").Rows("1:1").Insert Shift:=xlDown
Err_Execute:
If Err.Number = 0 Then
MsgBox "All have been copied!"
ElseIf Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
Yes, this is possible. You just have to set the Workbooks properly to be able to refer to them:
Dim masterWB As Workbook
Dim dailyWB As Workbook
'Set Current Workbook as Master
Set masterWB = Application.ThisWorkbook
'Set some Workbook as the one you are copying from
Set dailyWB = Workbooks.Open("PATH TO WORKBOOK HERE")
'Copy the Range from the Workbook and Paste it into the MasterWB
dailyWB.Sheets(1).Range("A1:J75").Copy masterWB.Sheets(1).Range("A1").Rows("1:1")
Close the Workbook without saving
dailyWB.Close False
'Clear the Variables
Set dailyWB = Nothing
Set masterWB = Nothing
Just modify the Sheets to match your needs and it should work
If you want to create a Worksheet on your Master Workbook and Rename it use this:
Dim tempWS as Worksheet
Set tempWS = masterWB.Sheets.Add
tempWS.Name = Format(Date, "mm-dd-yyyy")
Depending on the Format you want to use for the name, modify the "mm-dd-yyyy" to your needs. e. g. "yyyy.mm.dd"
I actually create worksheets programmatically and add button with a macro associated to these worksheets programmatically. What I want to do is that when I click on the button the content of the worksheet containing the button is copied to another worksheet.
There are actually two things that confuse me : Firstly I don't understand if the macro I associate to the button is located (I mean its code is located) in the file creating the worksheet or in the created worksheet itself.
Here is the code I create to add a button with an associated macro :
With newWorkBook.Worksheets(1).Buttons
.Add 350, 75, 173.25, 41.25
.OnAction = "'" & ThisWorkbook.FullName & "'!export_Click"
.Caption = "Exporter la fiche"
End With
newWorkBook.Worksheets("Feuil1").Name = "Valeurs"
The checkPVC_Click Sub is in a module located in the Excel file used to generate the worksheets.
Secondly, within the macro that is supposed to copy the content of a worksheet to another, I don't know how to refer differently to the two worksheets (source and target) in the code.
In the code below :
Dim newWorkBook As Workbook
Dim createdSheetColumnsTab(100) As String
Dim col As Integer
col = Cells(1, 8).Value
Set newWorkBook1 = Workbooks.Add
newWorkBook1.Worksheets("Feuil1").Cells(1, 1).Value = "Stat"
newWorkBook1.Worksheets("Feuil1").Cells(2, 1) = ActiveWorkbook.Worksheets("Valeurs").Cells(12, 1)
Here in the line col = Cells(1, 8).Value I access to the content of the worksheet which content I want to copy, and in the line newWorkBook1.Worksheets("Feuil1").Cells(1, 1).Value = "Stat" I access to the content of the "target" worksheet and I don't know how to refer to the content of the first worksheet in the following of the code in order to copy the content.
I hope I was clear, and I can add more precisions if necessary, sorry I don't master English so it's hard for me to explain the issue.
You can leave the Sub checkPVC_Click in the original workbook. Just ensure that you give full path and name of the file which has that macro. For example. Please ensure that the file from where you are running this macro is saved at least once.
Sub Sample()
Dim NewWorkbook As Workbook
Set NewWorkbook = Workbooks.Add
With NewWorkbook.Worksheets(1).Buttons
.Add 350, 15, 173.25, 41.25
.OnAction = "'" & ThisWorkbook.FullName & "'!checkPVC_Click"
End With
End Sub
Sub checkPVC_Click()
MsgBox "a"
End Sub
Regarding your Second question, you need to fully qualify the Cells object so that it know which cells are you referring to
ThisWorkbook will refer to the cell from the workbook which hosts the code.
Activeworkbook will refer to the cell from the workbook which is currently active.
Edit: Followup from comments. Is this what you are trying?
Sub Sample()
Dim newWorkBook As Workbook
Dim ws As Worksheet
Set newWorkBook = Workbooks.Add
Set ws = newWorkBook.Sheets(1)
ws.Name = "Valeurs"
With ws.Buttons
.Add 350, 15, 173.25, 41.25
.OnAction = "'" & ThisWorkbook.FullName & "'!checkPVC_Click"
End With
End Sub
Sub checkPVC_Click()
Dim OldWorkbook As Workbook, newWorkBook As Workbook
Dim createdSheetColumnsTab(100) As String
Set OldWorkbook = ActiveWorkbook
Set newWorkBook1 = Workbooks.Add
newWorkBook1.Worksheets("Feuil1").Cells(1, 1).Value = "Stat"
newWorkBook1.Worksheets("Feuil1").Cells(2, 1) = OldWorkbook.Worksheets("Valeurs").Cells(12, 1)
End Sub
To access the content of the first worksheet of workbook containing macro you need to use:
Thisworkbook.sheets(1).range("a1:a100") ' range as an example you can input anything
Hope it helped.
I'm new to using VBA and have found the code below. It works fine but I need all the rows in the source file. How can I change the code so I'm not limited to using the row numbers as the will be differten every time.
Private Sub Import1_Click()
' Get customer workbook...
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook
' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
' assume range is A1 - G10 in sheet1
' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)
targetSheet.Range("A6", "G10").Value = sourceSheet.Range("A2", "G6").Value
' Close customer workbook
customerWorkbook.Close
End Sub
Assuming you want to copy the entire sheet onto a blank sheet in your current workbook and only keep values (your question doesn't specify that too well), you could replace this line:
targetSheet.Range("A6", "G10").Value = sourceSheet.Range("A2", "G6").Value
With this:
sourceSheet.UsedRange.Copy targetSheet.Range("A1")
sourceSheet.UsedRange.Value = sourceSheet.UsedRange.Value
Hope that proves to do the trick!
UPDATE
Baed upon your last comment, try replacing this line:
sourceSheet.UsedRange.Copy targetSheet.Range("A1")
With this line:
Intersect(sourceSheet.UsedRange, sourceSheet.UsedRange.Offset(1,0)).Copy targetSheet.Range("A1")
The final part Range("A1") can be updated to paste the results wherever you want them.
Hope this does the trick!!
Just the following line has to be changed like I've given below:
targetSheet.Range("A6", "G10").Value = sourceSheet.Range("A2", "G6").Value
First, using name ranges (top-left of excel where the name of the cell appears), name the start and end cell of the source sheet. Say, you call them "start" and "end".
Now, you can also name your start cell in targetsheet. End cell is not required because it will paste everything anyways. This is optional and you can stay without naming it like below.
The code will then look like...
targetSheet.Range("A6").Value = sourceSheet.Range("start", "end").Value
If you name the targetSheet start cell ("start_target" for example) as well then it will be like this :
targetSheet.Range("start_target").Value = sourceSheet.Range("start", "end").Value