I can't seem to get my two open workbooks to set as variables. I have created a sub that opens the second one, so both now should be open.
But when I step through the code I get:
"rn-time error'438' object doesn't support this property or method.
I have tried both .Select and Activate. Both come back with errors.
have included the sub that opens the second workbook, for reference.
Sub copytoMaster()
Dim wkbk As Workbook
Dim NewFile As Variant
NewFile = "C:\Users\msheppar\Desktop\new holiday project\Master Holiday Tracker.xlsm"
If NewFile <> False Then
Set wkbk = Workbooks.Open(NewFile)
End If
End Sub
Sub CopyAndPaste()
Dim wbpast As Workbook
Dim wbcop As Workbook
Dim xlastrowcopy As Long
Dim xlastrowpast As Long
Dim xlastcolumnn As Long
Dim i As Integer
Dim j As Integer
Dim r As Integer
Dim rname As String
Set wbcop = Workbooks("Holiday form (9).xlsm")
Set wbpast = Workbooks("Master Holiday Tracker.xlsm")
'For i = 1 To xlastrowcopy
wbcop = ActiveSheet
Sheets("sheet4").Select
Related
I have a workbook that open another workbook and copies a range of data over. After that it does some data collection and sends an email. The issue I have is that the Workbook_Open() function to autorun this when the workbook is open does not work correctly. If I have the original workbook open and run it from the VB editor all works fine. If however, I let it run automatically it hangs and says the "Select method of the Worksheet class has failed"
Private Sub Workbook_Open()
Call send_Mail
End Sub
Private Sub send_Mail()
Dim Mail As CDO.Message
Set Mail = New CDO.Message
Dim strFilename As String: strFilename = "S:\Office\Requisition Logs\FY22\FY 2022.xlsx"
Dim wb2 As Workbook
Set wb2 = Workbooks.Open(Filename:=strFilename)
Dim vals As Variant
'Store the value in a variable:
vals = wb2.Sheets("FY2022 Log").Range("A2:AJ500").Value
'Close wb2:
wb2.Close savechanges:=False
Dim wb1 As Workbook
Set wb1 = ThisWorkbook
'Use the variable to assign a value to the other file/sheet:
wb1.Sheets("FY2022 Log").Range("A2:AJ500").Value = vals
wb1.Sheets("FY2022 Log").Select
Dim x As Integer
x = 1
Dim lastRow As Integer
Dim lastCol As Integer
Dim startRow As Integer
Dim numRows As Integer
startRow = 2
.............................
I do have the Workbook_Open() in the Workbook tab of the ThisWorkbook
I have:
Dim xlBook as Workbook
Dim xlSheet as Worksheet
Dim xlTable as ListObject
Dim xlTable Column as ListColumn
Dim xlChartObject as ChartObject
Dim xlTableObject as ListObject
Dim ObjectArray() as String
Dim ObjectIndexArray as Integer
'set the book'
Set xlBook = ThisWorkbook
'loop through each worksheet'
For each xlSheet in XlBook.Worksheets
'if we have charts
if xlSheet.ChartObjects.Count > 0 then
'grab each name
For each xlChartObject in xlSheet.ChartObjects
'update count
ObjectArrayIndex = ObjectArrayIndex + 1
ReDim Preserve ObjectArray(ObjectArrayIndex)
'add chart object to array
ObjectArray(ObjectArrayIndex) = xlChartObject.Name & "-" & xlSheet.Name & "-" & TypeName(xlChartObject)
'grab sheet
set xlSheet = xlBook.Worksheets("Export")
'grab table from sheet
set xlTable = xlSheet.ListObjects("ExportToPowerPoint")
'grab object column from table
Set xlTableColumn = xlTable.ListColumns("Object")
'set validation dropdown
With xlTableColumn.DataBodyRange.Validation
'delete old
.delete
'add new data
.add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(ObjectArray, "-")
'make sure its a dropdown
.InCellDropdown = true
end with
end sub
This code works well for grabbing charts, and similarly I utilized ListObject in order to then grab tables as well.
My Issue comes with creating another block of code to grab named ranges in excel. So not Tables or Charts
Any help would be greatly appreciated!
Activesheet.names should give array of named ranges on activeshee. Add that to for each loop and you should be done.
Names: Name, Range, Range Address
When you select a range in Excel and you use Name a range - Define name and you enter the name and press Ok, the name is 'saved' in workbook scope. So this code applies to workbook scope.
If you need to handle named ranges of worksheet scope (e.g. when you're using the same names on different worksheets), you will have to write the code somewhat differently.
The 'grab' procedures (Subs) illustrate how to return all names, range addresses and ranges (range objects) in an array and then print the contents (the Address property for ranges) to the Immediate window.
The 'get' procedure (Function) returns the array of the names and you could say it is the first 'grab' procedure written as a function.
The last procedure tests the function.
Here is another post I recently did on Names with links to some study material at the beginning.
The Code
Option Explicit
Sub grabNameNames()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim nmsCount As Long: nmsCount = wb.Names.Count
Dim nms() As String: ReDim nms(1 To nmsCount)
Dim nm As Name
Dim n As Long
For Each nm In wb.Names
n = n + 1
nms(n) = nm.Name
Next nm
If Not IsEmpty(nms) Then
Debug.Print Join(nms, vbLf)
End If
End Sub
Sub grabNameAddresses()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim nmsCount As Long: nmsCount = wb.Names.Count
Dim nma() As String: ReDim nma(1 To nmsCount)
Dim nm As Name
Dim n As Long
For Each nm In wb.Names
n = n + 1
nma(n) = nm.RefersToRange.Address(0, 0)
Next nm
If Not IsEmpty(nma) Then
Debug.Print Join(nma, vbLf)
End If
End Sub
Sub grabNameRanges()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim nmsCount As Long: nmsCount = wb.Names.Count
Dim nmr As Variant: ReDim nmr(1 To nmsCount)
Dim nm As Name
Dim n As Long
For Each nm In wb.Names
n = n + 1
Set nmr(n) = nm.RefersToRange
Next nm
If Not IsEmpty(nmr) Then
For n = 1 To UBound(nmr)
Debug.Print nmr(n).Address
Next n
End If
End Sub
Function getNameNames(wb As Workbook)
Dim nmsCount As Long: nmsCount = wb.Names.Count
Dim nms() As String: ReDim nms(1 To nmsCount)
Dim nm As Name
Dim n As Long
For Each nm In wb.Names
n = n + 1
nms(n) = nm.Name
Next nm
getNameNames = nms
End Function
Sub TESTgetNameNames()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim Data As Variant: Data = getNameNames(wb)
If Not IsEmpty(Data) Then
Debug.Print Join(Data, vbLf)
End If
End Sub
I am run the same piece of VBA code in Excel in two different ways.
1. From the developer tab, takes less than 2 sec.
2. Calling the macro from a userform, takes over a minute and freezes
Here is the code:
Sub Import()
Dim wbSource As Workbook
Dim wbDest As Workbook
Dim TargetSheet As Worksheet
Dim c As Range
Dim rng As Range
Dim i As Integer
Dim MyRange As Range
Dim SourceSheet As Worksheet
Dim source As String
Dim dest As String
Dim r As Range
Dim msg As String
source = Worksheets("Set-Up").Range("B11")
dest = Worksheets("Set-Up").Range("B8")
Set wbSource = Workbooks(source)
Set SourceSheet = wbSource.Worksheets("HFL01 Extract")
Set wbDest = Workbooks(dest)
Set TargetSheet = wbDest.Worksheets("INPUTS1")
With SourceSheet.Range("A1").CurrentRegion
For Each r In TargetSheet.Range("A1:N1") 'Range("A1:cc1")
Set c = .Rows(1).Find(r.Value, , , xlWhole, , 0)
If Not c Is Nothing Then
.Columns(c.Column).Copy
r.PasteSpecial xlPasteValues
End If
Next
Application.CutCopyMode = False
End With
Set fileDialog = Nothing
Set wbSource = Nothing
End Sub
Why does running the macro in different ways cause it to be slow? How do I make the macro run at the same speed when called from the userform?
I am Trying to run this Code, which will copy the Source sheet Row to Destination Sheet last Row, but my this code giving error 400 while compiling,
Advance Thanks for Help
Sub CopyData()
Dim sBook_t As String
Dim sBook_s As String
Dim sSheet_t As String
Dim sSheet_s As String
On Error GoTo Errorcatch
sBook_t = "C:\Users\Unknown\Desktop\Free\Calculators.xlsx"
Workbooks.Open (sBook_t)
sBook_s = "C:\Users\Unknown\Desktop\Free\PRODUCT_35.xlsm"
Workbooks.Open (sBook_s)
sSheet_t = "cstdatalist"
sSheet_s = "cstdata"
Sheets(sSheet_s).Range("A2").Copy Destination:=Sheets(sSheet_t).Range("A2")
End Sub
Have a try on following sub.
Sub CopyData()
Dim wb As Workbook
Dim sht, shtLocal As Worksheet
Dim rngPaste As Range
Dim rngLastData, wbPath As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
wbPath = "D:\dBook.xlsx"
Set wb = Workbooks.Open(wbPath)
Set sht = wb.Sheets(1)
Set shtLocal = ThisWorkbook.Sheets("Sheet1")
Set rngPaste = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1) 'Destination range set after last used cell of column A
rngLastData = shtLocal.Cells(Rows.Count, "A").End(xlUp).Address
shtLocal.Range("A1:" & rngLastData).Copy rngPaste
wb.Save
wb.Close
Set sht = Nothing
Set shtLocal = Nothing
Set rngPaste = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
enter code hereHere is my adjustment of your code. What I did is declared the workbooks and the worksheets separately. This way it is clear which workbook/sheet is the source and which is the destination.
Sub CopyData()
Dim sBook_t As String
Dim sBook_s As String
Dim workbook_t As Workbook
Dim sSheet_t As Worksheet
Dim sSheet_s As Worksheet
Dim sSheet_t As String
Dim sSheet_s As String
On Error GoTo Errorcatch
sBook_t = "C:\Users\Unknown\Desktop\Free\Calculators.xlsx"
set workbook_t = Workbooks.Open (sBook_t)
sBook_s = "C:\Users\Unknown\Desktop\Free\PRODUCT_35.xlsm"
set workbook_s = Workbooks.Open (sBook_s)
set sSheet_t = workbook_t.Sheets("cstdatalist")
set sSheet_s = workbook_s.Sheets("cstdata")
sSheet_s.Range("A2").Copy Destination:=sSheet_t.Range("A2")
End Sub
I am trying to create a VBA script that will gather data from four different Workbooks. For now, I am just testing the code with one Workbook, but I am receiving an error when I try to acquire the data. While I would like to retrieve the data from the four Workbooks without opening them, I will need to open them in order to find the last row of data. Here is my current code:
Public Sub GetData()
Application.ScreenUpdating = False
Dim LastRow As Integer
Dim WB As Workbook
Dim xlsPath As String
Dim xlsFilename As String
Dim SheetName As String
xlsPath = "C:\Users\a27qewt\My Documents\Document Retention\FI_DocumentRetention.xlsm"
Set WB = Workbooks.Open(xlsPath)
'Workbooks("FI_DocumentRetention.xlsm").Sheets("S&S Document Locations").Unprotect
LastRow = Workbooks("FI_DocumentRetention.xlsm").Sheets("S&S Document Locations").Cells(Rows.Count, "A").End(xlUp).Row
Workbooks("SS_Index.xlsm").Sheets("Document Index").Range(Cells(2, 1), Cells(LastRow, 5)).Value = _
Workbooks("FI_DocumentRetention.xlsm").Sheets("S&S Document Locations").Range(Cells(2, 1), Cells(LastRow, 5)).Value
WB.Close False
End Sub
I am receiving a 1004 application/object defined error in the Workbooks("FI_DocumentRetention.xlsm").Sheets("S&S Document Locations").Range... line. Any suggestions why?
You already solved your problem, but here's how I'd approach it
Public Sub GetData()
Dim LastRow As Long '<< not Integer
Dim WB As Workbook
Dim xlsPath As String
Dim xlsFilename As String
Dim SheetName As String
Dim shtSrc As Worksheet, shtDest As Worksheet, rngSrc As Range
Application.ScreenUpdating = False
xlsPath = "C:\Users\a27qewt\My Documents\Document Retention\FI_DocumentRetention.xlsm"
Set WB = Workbooks.Open(xlsPath)
Set shtSrc = WB.Sheets("S&S Document Locations")
Set shtDest = Workbooks("SS_Index.xlsm").Sheets("Document Index")
LastRow = shtSrc.Cells(shtSrc.Rows.Count, "A").End(xlUp).Row
Set rngSrc = shtSrc.Range(shtSrc.Range("A2"), _
shtSrc.Cells(LastRow, 5))
shtDest.Range("A2").Resize(rngSrc.Rows.Count, _
rngSrc.Columns.Count).Value = rngSrc.Value
WB.Close False
End Sub