I don't know why I am getting this error on the debug!
I have a table as follows:
I am doing a simple lookup, but it doesn't seem to work even the type are matched:
Here is my code
Sub projectLookUp2()
Dim mainWorkBook As Workbook
Dim ProjectListSheet As Worksheet
Dim newSheet As Worksheet
Set mainWorkBook = Workbooks("CPL ERICOLL Uploader final_20161109 (Autosaved).xlsm") 'this is the active workbook
Set ProjectListSheet = mainWorkBook.Worksheets("Project List")
Set newSheet = mainWorkBook.Worksheets("new sheet")
lrow = ProjectListSheet.Cells(Rows.Count, "C").End(xlUp).row
Dim projectName As String
Dim TGPassed As Variant
projectName = "XL M2M Initial Setup"
With ProjectListSheet
TGPassed = Application.VLookup(projectName, Range("C4:C" & lrow), 2, False)
Debug.Print CStr(TGPassed)
End With
'Debug.Print ProjectListSheet.Range("D10").Value
End Sub
I am just following a simple tutorial and this is how its done, I searched for some solution but none seemed to work
what I get is this in the debug window :
Error 2023
Related
I'm trying to import some data from a closed workbook in the same folder into my active workbook. This is what i have so far
Sub Import_Data()
Dim rng As Range
Dim WB2 As Workbook
Dim FName As String
Dim c1 As Worksheet
Set c1 = Sheets("c")
FName = Application.ActiveWorkbook.Path + "\_w" & Format((WorksheetFunction.WeekNum(Now) - 1), "00")
Set WB2 = Workbooks.Open(Filename:=FName)
ThisWorkbook.ChampSpecific1.Range("L3:O6").Value = WB2.Worksheets(2).Range("M3:P6").Value
WB2.Close
End Sub
When I run the macro i get the error "Method or Data Member Not Found" highlights ThisWorkbook.C1.Range (The c1 Part). It should be pulling the Worksheet "c" shouldn't it?
Best Regards
Remove ThisWorkbook. from ThisWorkbook.ChampSpecific1.Range("L3:O6").Value and it should work. Like this:
ThisWorkbook.ChampSpecific1.Range("L3:O6")
The problem comes, because you have already pjut a set on ChampSpecific1 worksheet and it knows his Parent. Thus, if you try to refer a new Parent, it does not like it.
To get the Parent write the following Debug.Print ChampSpecific1.Parent.Name on the line before the error.
You don't need the ThisWorkbook qualifier as it's already set. Try this (using SourceSht and TargetSht to keep things from getting confusing:
Sub Import_Data()
Dim SourceSht As Worksheet
Dim TargetSht As Worksheet
Dim FName As String
FName = Application.ActiveWorkbook.Path + "\AIMS_Report_w" & Format((WorksheetFunction.WeekNum(Now) - 1), "00")
Set SourceSht = Workbooks.Open(Filename:=FName).Worksheets(2)
Set TargetSht = Sheets("Summary-Champion Specific")
TargetSht.Range("L3:O6").Value = SourceSht.Range("M3:P6").Value
End Sub
I have a workbook with a master sheet for school report cards. I have a macro applied to a button for exporting information from the master sheet to separate, newly-generated sheets in the same workbook. A1:C71 is the template and goes to every new sheet, and the following columns of info, from D1:71 to Q1:71, each appear in separate sheets (always in D1:71).
Here's the screenshot (http://imgur.com/a/ZDOVb), and here's the code:
`Option Explicit
Sub parse_data()
Dim studsSht As Worksheet
Dim cell As Range
Dim stud As Variant
Set studsSht = Worksheets("Input")
With CreateObject("Scripting.Dictionary")
For Each cell In studsSht.Range("D7:Q7").SpecialCells(xlCellTypeConstants, xlTextValues)
.Item(cell.Value) = .Item(cell.Value) & cell.EntireColumn.Address(False, False) & ","
Next
For Each stud In .keys
Intersect(studsSht.UsedRange, studsSht.Range(Left(.Item(stud), Len(.Item(stud)) - 1))).Copy Destination:=GetSheet(CStr(stud)).Range("D1")
Next
End With
studsSht.Activate
End Sub
Function GetSheet(shtName As String) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(shtName)
If GetSheet Is Nothing Then
Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.Count))
GetSheet.Name = shtName
Sheets("Input").Range("A1:C71").Copy
GetSheet.Range("A1:D71").PasteSpecial xlAll
GetSheet.Range("A1:B71").EntireColumn.ColumnWidth = 17.57
GetSheet.Range("C1:C71").EntireColumn.ColumnWidth = 54.14
GetSheet.Range("D1:D71").EntireColumn.ColumnWidth = 22
End If
End Function`
I would now like to create a separate button to split the sheets into separate workbooks so that the master sheet can be kept for record keeping and the individual workbooks can be shared with parents online (without divulging the info of any kid to parents other than their own). I would like the workbooks to be saved with the existing name of the sheet, and wonder if there's a way to have the new workbooks automatically saved in the same folder as the original workbook without having to input a path name? (It does not share the same filename as any of the sheets).
I tried finding other code and modifying it, but I just get single blank workbooks and I need as many as have been generated (preferably full of data!), which varies depending on the class size. Here's the pathetic attempt:
`Sub split_Reports()
Dim splitPath As String
Dim w As Workbook
Dim ws As Worksheet
Dim i As Long, j As Long
Dim lastr As Long
Dim wbkName As String
Dim wksName As String
Set wsh = ThisWorkbook.Worksheets(1)
splitPath = "G:\splitWb\"
Set w = Workbooks.Add
For i = 1 To lastr
wbkName = ws
w.Worksheets.Add(After:=w.Worksheets(Worksheets.Count)).Name = ws
w.SaveAs splitPath
w.Close
Set w = Workbooks.Add
Next i
End Sub`
I have learned so much, and yet I know so little.
Maybe this will start you off, just some simple code to save each sheet as a new workbook. You would probably need some check that the sheet name is a valid file name.
Sub x()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
ws.Copy
ActiveWorkbook.Close SaveChanges:=True, Filename:=ws.Name & ".xlsx"
Next ws
End Sub
I am copying a range from one worksheet to the next using the following code:
Private Sub btn_Milestones_Click()
Dim projectref As String
Dim savelocation As String
Dim projectSearchRange As Range
Dim LastRow As Integer
Dim NewWorkbook As Workbook
Dim copy_range As Range
'set search value (porject key - unique)
projectref = cmb_Project.Value
Application.ScreenUpdating = False
Workbooks("Project tracker spreadsheet VBA").Activate
'find the project reference in the tracking spreadsheet
With Sheets("Project Tracking")
Set projectSearchRange = .Range("A:A").Find(projectref, , xlValues, xlWhole)
If Not projectSearchRange Is Nothing Then '<-- verify that find was successful
LastRow = projectSearchRange.Row
'file directory to save the new workbook in
savelocation = .Cells(LastRow, 5).Value
Else '<-- find was unsuccessful
MsgBox "Unable to find " & projectref
Exit Sub
End If
End With
Set copy_range = Range(Cells(LastRow, 11), Cells(LastRow, 34))
Worksheets("Milestone_Template").Range(copy_range).Copy 'application defined or object defined error occurs here
Worksheets("Project Tracking").Range("A7:X7").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
As the code illustrates, I am looking for a unique reference number in the "Project Tracking" Sheet, then using the row number to define a range to copy. copying that range and pasting the values of that range into a new sheet. However, I am getting the application error on the line indicated in the code. I've triple checked to make sure the worksheet names are correct.
I have a feeling it is to do with the way I've declared the range and how it is attempting to copy the values, but I can not see where it could be throwing this error from.
Can anybody see where I would be getting this error from, and what I need to do to resolve it?
Thanks.
Sorry you got beat up, I have edited question title so your specific problem is identified. Here's an attempted answer ...
It is quite difficult to debug without the data but it looks like copy_range is already of type Range, you seem to use it on the problem line like it was a String range expression like "A1:C3". So I have rewritten, you can go straight to copy_range.Copy.
The commenters are right that full qualification helps clarify issues, so I have done some full qualification but not all.
Try this
Option Explicit
Private Sub btn_Milestones_Click()
Dim projectref As String
Dim savelocation As String
Dim projectSearchRange As Range
Dim LastRow As Integer
Dim NewWorkbook As Workbook
Dim copy_range As Range
'set search value (porject key - unique)
projectref = cmb_Project.Value
Application.ScreenUpdating = False
Workbooks("Project tracker spreadsheet VBA").Activate
Dim wbSource As Excel.Workbook
Set wbSource = Workbooks("Project tracker spreadsheet VBA")
'find the project reference in the tracking spreadsheet
With Sheets("Project Tracking")
Set projectSearchRange = .Range("A:A").Find(projectref, , xlValues, xlWhole)
If Not projectSearchRange Is Nothing Then '<-- verify that find was successful
LastRow = projectSearchRange.Row
'file directory to save the new workbook in
savelocation = .Cells(LastRow, 5).Value
Else '<-- find was unsuccessful
MsgBox "Unable to find " & projectref
Exit Sub
End If
End With
Dim wsMilestoneTempate As Excel.Worksheet
Set wsMilestoneTempate = wbSource.Worksheets("Milestone_Template")
Set copy_range = wsMilestoneTempate.Range(wsMilestoneTempate.Cells(LastRow, 11), wsMilestoneTempate.Cells(LastRow, 34))
copy_range.Copy
''''Worksheets("Milestone_Template").Range(copy_range).Copy 'application defined or object defined error occurs here
Worksheets("Project Tracking").Range("A7:X7").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
I have an Excel workbook that has been working but this morning have en-counted an error.
The error message I get is,
Run-time error 1004
Unable to set the ListFillRangeProperty of the DropDown class
Below is my code - the error happens at ws.DropDowns("DropDownStart").
DropDownStart and DropDownEnd are the correct names for the drop downs on my sheet so not sure what is causing this error. When I debug print the name I get
mysheetName!$A$2:$A$338
which is correct and all the cells contain dates in them. So bit stuck!
Dim ws As Worksheet
Dim wsTime As Worksheet
Set wsTime = ThisWorkbook.Sheets(WSTSJPM)
Set ws = ThisWorkbook.Sheets(WSCHARTS)
' get last date
Dim lRow As Long
lRow = wsTime.Range("A65536").End(xlUp).Row
ws.Select
ws.DropDowns("DropDownStart").ListFillRange = wsTime.Name & "!" & wsTime.Range("A2:A" & lRow).Address
ws.DropDowns("DropDownEnd").ListFillRange = wsTime.Name & "!" & wsTime.Range("A2:A" & lRow).Address
Update for comments
I can change the dropdown manually the code can change it normally too. The workbook is not being shared.
The sheet name contain no spaces in it.
I believe I should be using an "=" in the fill range unless you know another way?
The DropDown is a form control of type list box and is on my worksheet
Another problem looks like you have no quotes around the sheet names.
This code seems to work for me
Sub populatecombobox()
Dim ws As Worksheet
Dim wsTime As Worksheet
Dim lRow As Long
Set wsTime = Sheets("WSTSJPM")
Set ws = Sheets("WSCHARTS")
With wsTime
lRow = .Cells(Rows.Count, "A").End(xlUp).Row
End With
ws.DropDowns("DropDownStart").ListFillRange = "WSTSJPM!$A$2:$A$" & lRow
ws.DropDowns("DropDownEnd").ListFillRange = "WSTSJPM!$A$2:$A$" & lRow
End Sub
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)