I have a VBA to copy and paste unique values from Sheet1 onto Sheet3. However i get the runtime error 438 when i run the VBA.
My VBA looks like this:
Sub UniqueList()
Application.ScreenUpdating = False
Dim lastrow As Long
Dim i As Long
Dim dictionary As Object
Set dictionary = CreateObject("scripting.dictionary")
ThisWorkbook.Sheet1.Activate
lastrow = Sheet1.Cells(Rows.Count, "M").End(xlUp).Row
On Error Resume Next
For i = 1 To lastrow
If Len(Cells(i, "M")) <> 0 Then
dictionary.Add Cells(i, "M").Value, 1
End If
Next
Sheet3.Range("a2").Resize(dictionary.Count).Value = _
Application.Transpose(dictionary.keys)
Application.ScreenUpdating = True
MsgBox dictionary.Count & " unique cell(s) were found and copied."
End Sub
The line that gets the error is:
ThisWorkbook.Sheet1.Activate
I run the VBA using a button from Sheet3. But i also tried running it using AltF8 and AltF11 with sheet1 open, nothing works.
Im not really sure why i get that error so i hope that there is a person who can help with a solution
Sheet1 isn't a member of ThisWorkbook. ThisWorkbook is a Workbook instance, and Workbook objects don't expose "dynamic members" for every worksheet in their Worksheets collection. Hence error 438, Object does not support property or method.
Sheet1 is [I presume] the CodeName of a worksheet in ThisWorkbook: it's a global-scope Worksheet object VBA conveniently creates, named after the (Name) property of the document module.
That Sheet1 object has a Parent property; like every Worksheet object, it already knows what Workbook instance it belongs to:
Debug.Print Sheet1.Parent Is ThisWorkbook
IntelliSense has been trying to tell you that (by not listing a Sheet1 member) - listen to what it says!
That said, fixing the instruction like this:
Sheet1.Activate
...doesn't solve the other problem: you're using Activate only so that the unqualified Cells calls can refer to that specific worksheet:
For i = 1 To lastrow
If Len(Cells(i, "M")) <> 0 Then
dictionary.Add Cells(i, "M").Value, 1
End If
Next
Instead, qualify them:
For i = 1 To lastrow
If Len(Sheet1.Cells(i, "M")) <> 0 Then
dictionary.Add Sheet1.Cells(i, "M").Value, 1
End If
Next
And then the Activate call becomes completely useless.
These implicit ActiveSheet references can be easy to introduce, and hard to spot. Rubberduck (an open-source VBE add-in project I manage) can help you locate them (and other things):
Related
I'm new to vba so am learning. I'm struggling to understand why this is failing in Excel 2016 and my research is drawing a blank. I have the following code
Option Explicit
Sub Range_End_Method()
Dim lRow As Long
Dim lCol As Long
Dim i As Integer
Dim rng As Range
Set rng = ActiveCell
lRow = Cells(Rows.Count, 1).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
Do While rng.Value <> Empty
If InStr(rng.Value, "Petrol") = 0 Then
currentRow = ActiveCell.Row
Worksheets("MySheet").Cells(currentRow, 5) = "Shopping"
Set rng = rng.Offset(1)
rng.Select
Else
currentRow = ActiveCell.Row
Worksheets("MySheet").Cells(currentRow, 9) = "Not Found"
Set rng = rng.Offset(1)
rng.Select
End If
Loop
End Sub
If I open the vba editor and type this into a "Microsoft Excel Objects" sheet I don't get an error. But if I run as a "Modules" naming my module as "m_End" I get an error thrown up saying
Compile Error
Variable not defined
The variable it highlights in vba editor is "currentRow" from the line in the first "If condition":
currentRow = ActiveCell.Row
I don't understand what the difference is and how to fix the error.
Any help would be appreciated.
Since you posted the rest of your code, that error is clearly because you did not declare currentRow in your Dim statements. Possibly option Explicit was not in your sheet module, so no error.
In any event, go to Tools ► Options ► Editor ► Code Settings and Select Require Variable Declaration It will save you loads of debugging time in the future. Perhaps in your sheet module you did not have Option Explicit
I would declare it as a Long
Oh, and in VBA there is no advantage (and there are some disadvantages) to declaring a data type as Integer. They get converted to Longs internally anyway; and the values which can be assigned are limited. Check VBA specifications for data types for the various limits.
I'm having a bit of a problem with this VBA code
Sub upONGOING_Train1()
ScreenUpdating = False
'set variables
Dim rFndCell As Range
Dim strData As String
Dim stFnd As String
Dim fCol As Integer
Dim oCol As Integer
Dim SH As Worksheet
Dim WS As Worksheet
Dim strFName As String
Dim objCell As Object
Set WS = ThisWorkbook.Sheets("Trains")
For Each objCell In WS.Range("L3:L100")
oCol = objCell.Column
strFName = WS.Cells(, oCol).Offset(objCell.Row - 1, 0)
On Error GoTo BLANK: 'skip macro if no train
Workbooks.Open Filename:=strFName 'open ongoing report
Set SH = Worksheets("Trains") 'set sheet
stFnd = WS.Cells(, oCol).Offset(objCell.Row - 1, 2).Value 'set connote
With SH
Set rFndCell = .Range("C3:C1100").Find(stFnd, LookIn:=xlValues)
If Not rFndCell Is Nothing Then
fCol = rFndCell.Column
WS.Cells(, oCol).Offset(objCell.Row - 1, 3).Resize(1, 6).Copy
SH.Cells(, fCol).Offset(rFndCell.Row - 1, 10).Resize(1, 6).PasteSpecial xlPasteValues 'paste values in ongoing report if connote found
ActiveWorkbook.Save 'save ongoing report
ActiveWorkbook.Close 'close ongoing report
Else 'Can't find the item
End If
End With
BLANK:
Next objCell
ScreenUpdating = True
End Sub
What I want it to do is - for every row in L3:L100
Open file listed in column "L" (if there or skip line to next one) and go to sheet
Match value from original sheet column "N" to "C3:C1100" in newly opened sheet
Copy columns "O:T" and paste relative to the matching value in the opened sheet(M:R) and save
However when I leave a gap of 2 rows it gives me the error for file not found instead of proceeding to the next loop like it does when there is only 1 row missing.
Seems i can't post images yet.
Also if anyone can point me in a good direction on how to open the sheet in the cell reference only if it is not already open it will usually only have 2 files to use (max of 4 at end of quarter).
Its just too much trouble to click OK on all the windows that pop up when you try to reopen an already open workbook.
If its any help to get your head around it.
I have 2 separate reports for 2 clients(new each quarter so max of 4 sheets at a time) that will already have the names to be searched (2 sheets in each book).
Any help would be greatly appreciated
Thanks heaps
Thanks to those who have put forth suggestions and code.
I'll them out tomorrow and failing that I've just come up with another idea that to re-purpose some other code I have but didn't realize would help.
The code basically copies what I need to a blank tab and deletes rows with a given value - with some formulas to help sort this would give me a block of rows with no breaks all going to the same destination file.
Thus allowing me to run the (a bit more streamlined Thanks everyone) loop over the remaining rows.
On Error GoTo BLANK
Workbooks.Open Filename:=strFName
Change the above into this:
On Error Resume Next
Workbooks.Open Filename:=strFName
If Err.Number <> 0 Then Goto Blank
As to hpw keep the workbook open, you can leave it open (no .close) but then when you want to open it check first if it is open (i.e. using Workbooks("name")), with some error handling using the same mechanism as above, if error exists then the wb is not already open, you open it.
Finally, avoid counting on the Active stuff, such as the ActiveWorkbook`. Instead, make an explicit reference to you wb, i.e.:
Set wb = Workbooks.Open(Filename:=strFName)
Set SH = wb.Worksheets("Trains")
to consider only not blank cells you can use SpecialCells() method of Range object and leave off any On Error GoTo statements, that should be used in very a few limited cases (one of which we'll see in a second)
furthermore you're using some uselessly long winded 'loops' to reference your relevant cells, for instance:
WS.Cells(, oCol).Offset(objCell.Row - 1, 0)
is equivalent to objCell itself!
and there are some more examples of that kind
finally, let's come to the workbooks open/close issue
you could:
use a Dictionary object to store the name of all opened workbooks so as to leave then open throughout your macro and close them all by the end of it
adopt a helper function that tries to set the wanted sheet (i.e. "Trains") in the wanted workbook (i.e. the one whose name is the current objCell value) and return False if not successful
all what above in this refactoring of your code:
Sub upONGOING_Train1bis()
Dim rFndCell As Range
Dim SH As Worksheet
Dim objCell As Range
Dim shtDict As New Scripting.Dictionary '<--| this is the dictionary that will store every opened workbook name as its 'keys'
Dim key As Variant
' Dim dec As String '<--| do you actually need it?
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Trains") '<-- reference your working worksheet
' dec = .Range("L1") '<-- what's this for? in any case take it out of for loops since its value doesn't depend on current loop variables
For Each objCell In .Range("L3:L100").SpecialCells(xlCellTypeConstants) '<--| loop through L3:L100 range not blank cells only
If TrySetWorksheet(objCell.Value, "Trains", SH) Then '<--|Try to set the wanted worksheet in the wanted workbook: if successful it'd retrun 'True' and leave you with 'SH' variable set to the wanted worksheet
shtDict(SH.Parent.Name) = shtDict(SH.Parent.Name) + 1
Set rFndCell = SH.Range("C3:C1100").Find(objCell.Offset(, 2).Value, LookIn:=xlValues, lookAt:=xlWhole) '<--| specify at least 'LookIn' and 'LookAt' parameters
If Not rFndCell Is Nothing Then rFndCell.Offset(, 10).Resize(, 6).Value = objCell.Offset(, 3).Resize(, 6).Value
End If
Next objCell
End With
For Each key In shtDict.Keys '<--|loop through opened workbooks dictionary keys
Workbooks(key).Close True '<--| close workbook whose name corresponds to current dictionary key
Next
Application.ScreenUpdating = True
End Sub
Function TrySetWorksheet(fileName As String, shtname As String, sht As Worksheet) As Boolean
Set sht = Nothing
On Error Resume Next
Set sht = Workbooks(Right(fileName, Len(fileName) - InStrRev(fileName, "\"))).Worksheets(shtname) '<--| try looking for an already open workbook with wanted name and wanted sheet
If sht Is Nothing Then Set sht = Workbooks.Open(fileName:=fileName).Worksheets(shtname) '<--| if not found then try opening the wanted workbook and set the wanted sheet in it
TrySetWorksheet = Not sht Is Nothing '<--| set the return value to the final result of attempts at locating the wanted sheet
End Function
I've created a small code to remove a range of cells from 2 separate worksheets and Worksheets that are starting with letter N, but always my code is giving me errors or Excel is crashing. The first and second line of code with ClearContents method is giving me those errors.
My code:
'clearing ranges
ThisWorkbook.Worksheets("Sheet1").range("A4", range("AY4").End(xlDown)).ClearContents
ThisWorkbook.Worksheets("Sheet2").range("A3", range("AK3").End(xlDown)).ClearContents
'deleting sheets
For Each sh In ThisWorkbook.Worksheets
If Left(sh.Name, 1) = "N" Then
ThisWorkbook.Worksheets(sh.Name).Delete
End If
Next sh
Thanks for the help!
edit to add some code for the ClearContents issue
ClearContents issue
you wrote
I want to delete the range from A4 until the right down corner of AY4
now it's up to what is to be intended as the "right down corner of AY4"
should it be the last non empty value on column AY then use:
With ThisWorkbook.Worksheets("Sheet001")
.Range("A4", .Cells(.Rows.Count, "AY").End(xlUp)).ClearContents
End With
you may need some more code to handle the case the first non empty cell in column "AY" is above row 4
Sheet Deletion
you may want to try the "Array" approach to exploit an array flavour of the Item property of Worksheets collection and have a one-shot sheets deletion:
Option Explicit
Sub ws()
Dim sh As Worksheet
Dim shtsToDelete As String
With ThisWorkbook
For Each sh In .Worksheets
If Left(sh.name, 1) = "N" Then shtsToDelete = shtsToDelete & sh.name & "\" '<-_| store sht names in a string delimiting them with an invalid character for sheet names
Next sh
If shtsToDelete <> "" Then '<--| if any sheet to be deleted has been found
Application.DisplayAlerts = False '<--| disable alerts to prevent popping out of msgbox prompting you to confirm sheets deletion
.Worksheets(Split(Left(shtsToDelete, Len(shtsToDelete) - 1), "\")).Delete '<--| delete list-sheets in one shot
Application.DisplayAlerts = True '<--| enable alerts back
End If
End With
End Sub
The error appears because you are not allowed to delete objects inside of the current for each loop. Try using a for loop, like this:
For i = ThisWorkbook.Worksheets.Count to 1 Step -1
If Left(ThisWorkbook.Worksheets(i).name, 1) = "N" Then
ThisWorkbook.Worksheets(i).Delete
End If
Next i
your Range definition is wrong, in the inner Range method call, you don't access the range of a specific sheet, so it uses Range of the default sheet. Second problem: If you delete something in a collection, you should loop backwards over the collection because otherwise the Delete operation leads index changes during the loop.
Dim wsheet1 As Worksheet
Dim wsheet2 As Worksheet
Set wsheet1 = ThisWorkbook.Worksheets("Sheet1")
Set wsheet2 = ThisWorkbook.Worksheets("Sheet2")
wsheet1.Columns("A:AY").ClearContents
wsheet2.Columns("A:AK").ClearContents
For i = ThisWorkbook.Worksheets.Count To 1 Step -1
If Left(ThisWorkbook.Worksheets(i).Name, 1) = "N" Then
ThisWorkbook.Worksheets(i).Delete
End If
Next i
this is my first post on StackExchange! I've been using StackExchange for answers, but now i really have a question.
I am trying to add a column in excel using vba. This is procedure is part of a bigger sub function of which I created a new workbook and copy a series of sheets from a different workbook over.
Workbooks.Add
Set TTB = ActiveWorkbook
'add a bunch of sheets here
'sheetName = specific_sheet
Set ttb_sheet = TTB.Sheets(sheetName)
ttb_sheet.Columns("I:I").Insert Shift:=xlToRight
With this i get a runtime error of 1004: 'Insert method of Range class failed'
I tried following a series of questions on StackOverflow...
Select method of Range class failed via VBA
VBA error 1004 - select method of range class failed
It seems like the solution is to select the sheet first, then select the range. I have tried this and there was no luck. Anyone have any insight?
Here's my main sub code..
Sub create_TTB_workbook(TTB_name_)
'create TTB workbook
Dim wsHelper As New WorksheetHelper
Dim final_TTB As Workbook
Dim ttb_sheet As Worksheet
ttb_wb = ActiveWorkbook.name
Workbooks(ttb_wb).Activate
PCB_tab = 0
ST_COMP_tab = 0
For Each WS In Worksheets
If WS.name = "PCB_PIN_REPORT" Then
PCB_tab = 1
End If
If WS.name = "ST_PIN_REPORT" Then
ST_COMP_tab = 1
End If
Next WS
Workbooks.Add
Set TTB = ActiveWorkbook
new_ttb_wb = TTB.name
Debug.Print (new_ttb_wb)
If PCB_tab = 1 Then
wsHelper.copySheet ttb_wb, "PCB_PIN_REPORT", new_ttb_wb, "PCB_PIN_REPORT"
End If
If ST_COMP_tab = 1 Then
wsHelper.copySheet ttb_wb, "ST_PIN_REPORT", new_ttb_wb, "ST_PIN_REPORT"
End If
wsHelper.copySheet ttb_wb, TTB_name_, new_ttb_wb, TTB_name_
' TRIED A BUNCH OF METHODS here...
'Workbooks(ttb_wb).Sheets(TTB_name_).Cells.copy
'Sheets.Add.name = TTB_name_
'ActiveSheet.paste
'Sheets(TTB_name_).Activate
'Columns("I:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Worksheets(TTB_name_).Range("I1").EntireColumn.Insert
'Columns("I:I").Select
'Columns("I:I").Insert Shift:=xlToRight
Set ttb_sheet = Sheets(TTB_name_)
ttb_sheet.Columns("I:I").Insert Shift:=xlToRight
Columns("K").copy Destination:=Range("I1")
Range("I6") = "header name"
End Sub
Whenever I run into an issue like this, I always isolate the code to its simplest form. Once I get it working at that level, I add it back in to the full application and can usually figure out what I did wrong.
I've written a simple version of what you are trying to do. Note that I've included a few Debug.Print statements to help me verify what is going on. The debug messages will appear in your Immediate window. Obviously you can also step through the code and examine variables as you go.
To get this to work, create a workbook and save it as DestinationWorkbook.xlsx. Then open another workbook and insert the code below.
Sub InsertColumnInDestinationWorksheet()
Dim sourceWb As Workbook
Dim targetWb As Workbook
Dim sourceWs As Worksheet
Dim targetWs As Worksheet
Set sourceWb = ThisWorkbook
Debug.Print sourceWb.Name
Set targetWb = Workbooks("DestinationWorkbook.xlsx")
Debug.Print targetWb.Name
Set sourceWs = sourceWb.Sheets("Sheet1")
Debug.Print sourceWs.Name
Set targetWs = targetWb.Sheets("Sheet1")
Debug.Print targetWs.Name
targetWs.Range("I1").Value2 = "Moving right along..."
targetWs.Columns("I:I").Insert shift:=xlToRight
End Sub
After running the code, you can examine the target sheet. You should see the text we wrote into column I is now in column J.
This works for me when I change the variable naming to:
Sub testingg()
Dim ttb_sheet As Worksheet
Set ttb_sheet = Sheets(1)
ttb_sheet.Columns("I:I").Insert Shift:=xlToRight
End Sub
So I presume there's an issue with the way you reference the workbook when setting ttb_sheet on line 3. Note that you add a workbook but you aren't actually 'activating' it necessarily. And are you sure the 'Sheetname' actually exists in the TTB workbook?
Okay, so I am relatively new to Excel VBA. I am trying to do something which seems quite simple to me and there are many, many examples of how to do it which I have read exhaustively but I cannot seem to get past this so...here goes.
I am trying to paste a range of cells from one worksheet to another in Excel Microsoft Office Professional Plus 2010. I think I have reduced the problem to the absolute simplest form possible to illustrate the problem. This is just a snippet. The VictimResults and TempWorksheet variables are set higher up. I didn't include the code because I thought it might confuse the articulation of the problem.
Dim SourceWorksheet As Worksheet
Dim TargetWorksheet As Worksheet
Dim SourceRange As Range
Dim TargetRange As Range
Set SourceWorksheet = VictimResults
Set TargetWorksheet = TempWorksheet
Set SourceRange = Cells(1, 1)
Set TargetRange = Cells(1, 1)
TargetWorksheet.Range(TargetRange) = SourceWorksheet.Range(SourceRange)
I have placed the variables SourceWorksheet, TargetWorksheet, SourceRange, and TargetRange in a watch and set a breakpoint at the last line and they are all valid objects (not null). When I step over the breakpoint I get a dialog box which simply says "400".
Any help is much appreciated.
---edit---
I have created this complete VBA file that replicates the problem. Thought that might help someone answer.
Option Explicit
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Range(Cells(1, 1)).Value = GetFirstWorksheetContainsName("Sheet2").Range(Cells(1, 1)).Value
End Sub
Function GetFirstWorksheetContainsName(worksheetNameContains) As Worksheet
Dim m As Long
Dim result As Worksheet
m = 1
Do
If InStr(1, Sheets(m).Name, worksheetNameContains) Then
Set result = Sheets(m)
Exit Do
End If
m = m + 1
Loop Until m > ThisWorkbook.Worksheets.Count
Set GetFirstWorksheetContainsName = result
End Function
Here is something else I tried which yields something a little more verbose.
Option Explicit
Sub Main()
Sheets("Sheet1").Select
Range(Cells(1, 1)).Select
Selection.Copy
Sheets("Sheet2").Select
Range(Cells(1, 1)).Select
ActiveSheet.Paste
End Sub
It gives me a "Method 'Range' of object '_Global' failed" error when executing the first Range(Cells(1, 1)).Select line.
If you are trying to copy and paste why not use .copy and .pastespecial. They may slow down your code a little bit but as long as your aren't copying and pasting thousands of things it should be ok.
I'm not sure where the 400 is coming from, but the exception that is thrown is the same is in your verbose example (1004 - "Method 'Range' of object '_Worksheet' failed", and is thrown for the same reason.
The problem is how you're addressing the Range. Cells(1, 1) is implicitly set to the active worksheet, not whatever range you are passing it to as a parameter. Since you only need one cell, you can just use the .Cells property instead:
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Cells(1, 1).Value = _
GetFirstWorksheetContainsName("Sheet2").Cells(1, 1).Value
End Sub
If you need to copy more than one cell, you'll have to either grab a reference to a worksheets instead of inlining the calls to GetFirstWorksheetContainsName if you use dynamic ranges:
Sub Main()
Dim source As Worksheet
Dim data As Range
Set source = GetFirstWorksheetContainsName("Sheet2")
Set data = source.Range("A1:B2")
GetFirstWorksheetContainsName("Sheet1").Range(data.Address).Value = data.Value
End Sub
Or hard code it:
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Range("A1:B2").Value = _
GetFirstWorksheetContainsName("Sheet2").Range("A1:B2").Value
End Sub