I have 2 workbooks that I run macros on "Air.xlsx" and "Ocean.xlsx", they are basically the same but for different purpose. I want to check if one of them is open , and set one of them as Wsht . I can't set them as set Wsht = activesheet because the macro starts from a different sheet.
Set Wsht = Workbooks("Air").ActiveSheet
Set Wsht = Workbooks("Ocean").ActiveSheet
an error would occur on this because i would only have one of them open.
I was suggested using below method, but i don't think it's an efficient way to do it
For Each wb In Workbooks
If wb.Name = "Air.xlsx" Then
Set PASsht = Workbooks("Air").ActiveSheet
End If
Next
Is there a way to check if Air or Ocean sheet is open and set one as Wsht?
Thanks
You can specify a sheet on whichever workbook is open. Try the code below.
Sub Test()
Dim wrksht As Worksheet
If WorkbookIsOpen("Air.xslx") Then
Set wrksht = Workbooks("Air.xlsx").Worksheets("Sheet1")
ElseIf WorkbookIsOpen("Ocean.xlsx") Then
Set wrksht = Workbooks("Ocean.xlsx").Worksheets("Sheet1")
Else
'Neither book is open, throw an error or something.
End If
End Sub
Public Function WorkbookIsOpen(FileName As String) As Boolean
Dim TestBk As Workbook
'Trying to set a reference to a closed workbook will
'throw an error - Err.Number = 0 will return TRUE or FALSE.
On Error Resume Next
Set TestBk = Workbooks(FileName)
WorkbookIsOpen = (Err.Number = 0)
On Error GoTo 0
End Function
Related
I am trying to write a vba script that will allow me to vlookup values from Sheet(3) to different Sheet(i) - and paste it on range"R2" on the Sheet(i) - I also want it to go to the end of the values in Column M on Sheet(i) [if this is possible]. I basically want to run through all the different "i" sheets on the workbook. Sheet (3) has all the data that needs to be copied on all the other "i" sheets.
I keep getting an error with my code below.
Sub CopyTableau1Data()
Dim wka As Worksheet
Dim wkb As Worksheet
ShtCount = ActiveWorkbook.Sheets.Count
For i = 9 To ShtCount
With ThisWorkbook
Set wka = .Sheets(i)
Set wkb = .Sheets(3)
End With
Worksheets(i).Activate
If IsError(Application.WorksheetFunction.VLookup(wka.Range("M2"), wkb.Range("E:T"), 14, 0)) Then
wka.Range("R2").Value = ""
Else
wka.Range("R2").Value = Application.WorksheetFunction.VLookup(wka.Range("M2"), wks.Range("E:T"), 14, 0)
End If
Next i
End Sub
IsError does not work with Application.WorksheetFunction.VLookup or WorksheetFunction.VLookup, only with Application.VLookup.
It is faster and easier to return Application.Match once to a variant type variable and then test that for use.
dim am as variant
'are you sure you want wkb and not wks here?
am = Application.match(wka.Range("M2"), wkb.Range("E:E"), 0)
If IsError(am) Then
wka.Range("R2") = vbnullstring
Else
'are you sure you want wks and not wkb here?
wka.Range("R2") = wks.cells(am, "R").value
End If
Note the apparent misuse of wkb and wks in two places. I don't see the point of looking up a value in one worksheet, testing that return then using the results of the test to lookup the same value in another worksheet.
You can use the following code:
Sub CopyTableau1Data()
Dim wka As Worksheet
Dim wkb As Worksheet, i As Integer
ShtCount = ActiveWorkbook.Sheets.Count
For i = 9 To ShtCount
With ThisWorkbook
Set wka = .Sheets(i)
Set wkb = .Sheets(3)
End With
Worksheets(i).Activate
wka.Range("R2") = aVL(i)
Next i
End Sub
Function aVL(ByVal wsno As Integer) As String
On Error GoTo errhandler:
aVL =
Application.WorksheetFunction.VLookup(ActiveWorkbook.Worksheets(wsno).Range("M2"),
ActiveWorkbook.Worksheets(3).Range("E:T"), 14, False)
errhandler:
aVL = ""
End Function
When you try to check an error by isError, program flow can immediately return from the sub depending on the error. You could use on error in your sub to prevent that but this would only handle the first error. By delegating the error handling to a function you can repeatedly handle errors in your loop.
I assumed you wanted to use wkb.Range("E:T") instead of wks.Range("E:T").
I am still very new to VBA and am trying to combine certain worksheets from different workbooks.
For example:
I have a workbook called "One" with multiple worksheets (A,B,C,D).
I have another workbook called "Two" with multiple worksheets (E,F,G,H).
I want to take worksheet A from workbook One and worksheets F and G from workbook Two. I wish to put these different worksheets in a new workbook called "Three."
My fields in worksheets A and F are in the exact same format, so I also wish to combine these two worksheets and put F data in the same fields under the A data, as soon as my cells containing A data finishes.
Could anyone help me with this code??
If anyone also has any links to VBA for beginners that would be highly appreciated.
Take a look at example:
'enforce declaration of variables
Option Explicit
Sub CombineWorkbooks()
Dim sWbkOne As String, sWbkTwo As String
Dim wbkOne As Workbook, wbkTwo As Workbook, wbkThree As Workbook
Dim wshSrc As Worksheet, wshDst As Worksheet
On Error GoTo Err_CombineWorkbooks
'get the path
sWbkOne = GetWbkPath("Open workbook 'One'")
sWbkTwo = GetWbkPath("Open workbook 'Two'")
'in case of "Cancel"
If sWbkOne = "" Or sWbkTwo = "" Then
MsgBox "You have to open two workbooks to be able to continue...", vbInformation, "Information"
GoTo Exit_CombineWorkbooks
End If
'open workbooks: 'One' and 'Two'
Set wbkOne = Workbooks.Open(sWbkOne)
Set wbkTwo = Workbooks.Open(sWbkTwo)
'create new one - destination workbook
Set wbkThree = Workbooks.Add
'define destination worksheet
Set wshDst = wbkThree.Worksheets(1)
'start copying worksheets
'A
Set wshSrc = wbkOne.Worksheets("A")
wshSrc.UsedRange.Copy wshDst.Range("A1")
'F
Set wshSrc = wbkTwo.Worksheets("F")
wshSrc.UsedRange.Copy wshDst.Range("A1").End(xlDown)
'G
Set wshSrc = wbkTwo.Worksheets("G")
wshSrc.UsedRange.Copy wshDst.Range("A1").End(xlDown)
'done!
Exit_CombineWorkbooks:
On Error Resume Next
Set wbkThree = Nothing
If Not wbkTwo Is Nothing Then wbkTwo.Close SaveChanges:=False
Set wbkTwo = Nothing
If Not wbkOne Is Nothing Then wbkOne.Close SaveChanges:=False
Set wbkOne = Nothing
Set wshDst = Nothing
Set wshSrc = Nothing
Exit Sub
Err_CombineWorkbooks:
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_CombineWorkbooks
End Sub
Function GetWbkPath(ByVal initialTitle) As String
Dim retVal As Variant
retVal = Application.GetOpenFilename("Excel files(*.xlsx),*.xlsx", 0, initialTitle, , False)
If CStr(retVal) = CStr(False) Then retVal = ""
GetWbkPath = retVal
End Function
Note: Above code has been written ad-hoc, so it may not be perfect.
[EDIT2]
If you would like to copy data into different sheets, please, replace corresponding code with below, but firstly remove these lines:
'define destination worksheet
Set wshDst = wbkThree.Worksheets(1)
later:
'start copying data
'A
Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
wshDst.Name = "A"
Set wshSrc = wbkOne.Worksheets("A")
wshSrc.UsedRange.Copy wshDst.Range("A1")
'F
Set wshSrc = wbkTwo.Worksheets("F")
Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
wshDst.Name = "F"
wshSrc.UsedRange.Copy wshDst.Range("A1")
'G
Set wshSrc = wbkTwo.Worksheets("G")
Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
wshDst.Name = "G"
wshSrc.UsedRange.Copy wshDst.Range("A1")
Good luck!
So my code was working fine, until IT upgraded me to Excel 2013 and the SDI interface. Now it looks like the Sheets.Add function doesn't return the proper worksheet. The template is added to the correct workbook (Template1) but when I use the returned worksheet, it's referencing a sheet from the active workbook, before all the VBA code ran.
Public Function Worksheet_AddTemplate(TargetBook As Excel.Workbook, _
TemplateFile as String) As Excel.Worksheet
Dim ws As Excel.Worksheet
Debug.Print TargetBook.Name 'Output-->Template1
Set ws = TargetBook.Sheets.Add( _
After:=TargetBook.Sheets(TargetBook.Sheets.Count), _
Type:=TemplateFile)
Debug.Print ws.Parent.Name 'Output-->Book1
Set Worksheet_AddTemplate = ws
Set ws = Nothing
End Function
Can someone else verify that this is happening to you with Excel 2013, and that there isn't something that I'm missing here.
Thanks
P.S. I use a similar routine to create the template workbook/first sheet with no issues.
Edit: The Code is being called from an Add-In. Here is how I call the Function, more or less (I've simplified the routines because it would be too long otherwise)
Private Sub ImportDataFile()
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim sUnit As String, sTemplateFile As String
Dim u As Integer, nUnits As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
' ...Some setup stuff that I wont bother you with
sTemplateFile = Environ("Temp") & "\Template1.xlt"
For u = 0 To nUnits - 1
If wb Is Nothing Then
Set wb = Workbook_NewTemplate(sTemplateFile)
Set ws = wb.Worksheets(1)
Else
Set ws = Worksheet_AddTemplate(wb, sTemplateFile)
End If
ws.range("H6") = sUnit
' More Loops & writing to cells
For i = 0 To g_Data(f).ItemCount - 1
' Blah, blah, blah
Next
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
I've noticed that if I add 2x DoEvents anywhere in between creating the workbook and adding the second sheet it will work as it did before.
Also, if I use this code in the Worksheet_AddTemplate function it seems to work...
Set wb = Application.Workbooks.Add(Template:=TemplateFile)
Set ws = wb.Worksheets(1)
ws.Copy After:=TargetBook.Sheets(TargetBook.Sheets.Count)
Set ws = TargetBook.Sheets(TargetBook.Sheets.Count)
I have the below code where the user is promted to select a workbook, I want to ensure that the user is selecting a specific file, and to do this I want to verify upon opening the workbook that the Sheet names are matching what I am expecting them to be:
Private Sub CommandButton1_Click()
Dim wb1 As Workbook, wb2 As Workbook
Dim Ret1
Set wb1 = ActiveWorkbook
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please a file to load from")
If Ret1 = False Then Exit Sub
Set wb2 = Workbooks.Open(Ret1)
If wb2.Sheet1.Name = "Sum" And wb2.Sheet2.Name = "Names" And wb2.Sheet3.Name = "Things" Then
MsgBox "Fine"
'Code Here
Else
MsgBox "Issue"
'Code Here
End If
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wb1 = Nothing
End Sub
Unfortunately when I run the above code I get an "Object doesn't support this property or method error." on the line If wb2.Sheet1.Name = "Sum" And wb2.Sheet2.Name = "Names" And wb2.Sheet3.Name = "Things"
Help please!
You can use this function to check whether sheet exist or not:
Function IsSheetExist(wb As Workbook, shName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = wb.Worksheets(shName)
On Error GoTo 0
IsSheetExist = Not ws Is Nothing
End Function
and use it like this:
If IsSheetExist(wb2, "Sum") And IsSheetExist(wb2, "Names") And IsSheetExist(wb2, "Things") Then
MsgBox "Fine"
'Code Here
Else
MsgBox "Issue"
'Code Here
End If
if you want to check whether thouse sheets exist in workbook in specific order, you can use this approach:
Function IsContainsSheetsInOrder(wb As Workbook) As Boolean
IsContainsSheetsInOrder = False
If wb.Sheets.Count < 3 Then Exit Function
If wb.Sheets(1).Name <> "Sum" Then Exit Function
If wb.Sheets(2).Name <> "Names" Then Exit Function
If wb.Sheets(3).Name <> "Things" Then Exit Function
IsContainsSheetsInOrder = True
End Function
and then:
If IsContainsSheetsInOrder(wb2) Then
MsgBox "Fine"
'Code Here
Else
MsgBox "Issue"
'Code Here
End If
Or, sticking closer to his original script, change wb1.sheet#.Name to wb1.sheets(#).Name like this:
If wb2.Sheets(1).Name = "Sum" And wb2.Sheets(2).Name = "Names" And wb2.Sheets(3).Name = "Things" Then
I want to import data from multiple workbooks, all from the same sheet index (3).
I'm new to vba, and I figured out how to open multiple files up, and also to copy data from one sheet to another sheet in a different workbook for a single file, but I can't seem to figure out how to do that for multiple files.
I highlighted where the error is, it tells me "object doesn't support this property or method"
Could you please help?
Thanks
Sub dataimport()
' Set Vars
Dim ArbinBook As Workbook, DataBook As Workbook
Dim i As Integer, j As Integer
Dim Caption As String
Dim ArbinFile As Variant, DataFile As Variant
' make weak assumption that active workbook is the target
Set DataBook = Application.ActiveWorkbook
' get Arbin workbook
Caption = "Please select an input file"
' To set open destination:
' ChDrive ("E")
' ChDir ("E:\Chapters\chap14")
' With Application
'Set "arbinfile" as variant, the "true" at end makes it into an array
ArbinFile = Application.GetOpenFilename(, , Caption, , True)
'Exit when canceled
If Not IsArray(ArbinFile) Then
MsgBox "No file was selected."
Exit Sub
End If
Dim targetSheet As Worksheet
Set targetSheet = DataBook.Sheets(1)
'Open for every integer i selected in the array "arbinfile"
For i = LBound(ArbinFile) To UBound(ArbinFile)
Set ArbinBook = Workbooks.Open(ArbinFile(i))
targetSheet.Range("A2", "G150").Value = ArbinBook.Sheets(3).Range("A2", "G150").Value
**ERROR at the line above**
Workbooks(DataSheet).Activate 'Reactivate the data book
Worksheets(1).Activate 'Reactivate the data sheet
ActiveWorkbook.Sheets(1).Copy _
after:=ActiveWorkbook.Sheets(1)
Workbooks(ArbinFile(1)).Activate 'Reactivate the arbin book(i)
ArbinBook.Close
Next i
Beep
End Sub
My instinct tells me that ArbinBook.Sheets(3) is a Chart-sheet, not a WorkSheet (or, at least, it is something other than a WorkSheet). It might be hidden as well, but it will still be indexed as (3).
If so, change Sheets(3) to Worksheets(3).
Added: BTW If true, this also demonstrates why using index-numbers is unreliable. If at all possible, refer to a worksheet by its name. (I appreciate that this may not always be possible.)
Added (from comments) There is nothing named DataSheet in your code. Add Option Explicit to the top of your module to indicate all such errors.
Try changing the line Set ArbinBook = Workbooks.Open(ArbinFile(i))
to Set ArbinBook = Workbooks(arbinfile(i))
I could be wrong, but I think it's trying to set your workbook object to become the action of opening another workbook, instead of labeling it as the workboook.
Sub Multiple()
Application.DisplayAlerts = False
Application.EnableEvents = False
Dim exlApp As Excel.Application
Dim exlWb1 As Excel.Workbook
Dim exlWb2 As Excel.Workbook
Dim exlWb3 As Excel.Workbook
Dim exlWs1 As Excel.Worksheet
Dim exlWs2 As Excel.Worksheet
Dim exlWs3 As Excel.Worksheet
Set exlApp = CreateObject("Excel.Application")
Set exlWb1 = exlApp.Workbooks.Open("C:\yourpath1\file1.xls")
Set exlWb2 = exlApp.Workbooks.Open("C:\yourpath2\file2.xls")
Set exlWb3 = exlApp.Workbooks.Open("C:\yourpath3\file3.xls")
Set exlWs1 = exlWb.Sheets("Sheet1")
Set exlWs2 = exlWb.Sheets("Sheet1")
Set exlWs3 = exlWb.Sheets("Sheet1")
exlWb1.Activate
exlWb2.Activate
exlWb3.Activate
'code
exlWb.Close savechanges:=True
exlWb.Close savechanges:=True
exlWb.Close savechanges:=True
Set exlWs1 = Nothing
Set exlWs2 = Nothing
Set exlWs3 = Nothing
Set exlWb1 = Nothing
Set exlWb2 = Nothing
Set exlWb3 = Nothing
exlApp.Quit
Set exlApp = Nothing
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub