I am trying to run a code that I found also here. the code is removing duplicates on each column on each spreed sheet on a workbook treating it as a separate entity. whenever I try to run the code the compiler error says "sub or function not defined" and there is a yellow highlight on the most upper part and the "LastCell" got a blue highlight. I already add the solver reference but still it gives me the same error. I just can't figure out what the problem is if it's on the code or should I add another reference.
Sub Removeduplicates()
Dim ws As Workbook
Dim lLastcol As Long
Dim lLastrow As Long
Dim i As Long
For Each ws In ThisWorkbook.Worksheets
lLastcol = LastCell(ws).Column
For i = 1 To lLastcol
lLastrow = LastCell(ws, i).Row
With ws
.Range(.Cells(1, i), .Cells(lLastrow, i)).Removeduplicates Columns:=1, Header:=xlNo
End With
Next i
Next ws
End Sub
Looks like lasy cell is the function you thought you had. We is the worksheet passed in. Thee function will use something like
Function lastcell(w as worksheet) as range
Set Lastcell=w.range("a" & w.rows.count).end(xlup)
End function
After deciphering your code snippet, this is the best that I can come up with.
Function lastCell(ws As Worksheet, _
Optional c As Variant, _
Optional r As Variant) As Range
With ws
If IsMissing(c) And IsMissing(r) Then
Set lastCell = .Cells.SpecialCells(xlCellTypeLastCell)
ElseIf IsMissing(c) And Not IsMissing(r) Then
Set lastCell = .Cells(r, .Columns.Count).End(xlToLeft)
ElseIf IsMissing(r) And Not IsMissing(c) Then
Set lastCell = .Cells(.Rows.Count, c).End(xlUp)
Else
Set lastCell = .Cells(r, c)
End If
End With
End Function
Copy that code to a module code sheet in your VBA project. It can tested with a short sub procedure like the following.
Sub test()
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
Debug.Print lastCell(ws1).Address(0, 0) '<~~ last cell on worksheet
Debug.Print lastCell(ws1, 3).Address(0, 0) '<~~ last used cell in column C
Debug.Print lastCell(ws1, , 4).Address(0, 0) '<~~ last used column on row 4
End Sub
If you're referring to the solution of Darren Bartrup-Cook here, make sure to copy the function LastCell to your code as well.
Related
I am trying to do a copy in VBA, as part of a bigger macro so it needs to be in VBA, of an unknown range in a specific worksheet.
I have this code that work if I am in that worksheet:
Sub Copy()
Range("O2", Range("O" & Cells(Rows.Count, "A").End(xlUp).Row)).copy
End Sub()
And I have below that works for a specific range:
Sub Test()
Worksheets("Data").Range("O2:O10").Copy
End Sub()
How can I make the second code work as unspecific.
Thanks,
You should practice to always fully qualify all your Sheet and Range objects.
The code below is a little long, but it's good practice to define and set all your objects and variables.
Code
Option Explicit
Sub Test()
Dim Sht As Worksheet
Dim LastRow As Long
' set your worksheet object
Set Sht = ThisWorkbook.Worksheets("Data")
With Sht
' get last row in column A
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' copy dynamic range in column O
.Range("O2:O" & LastRow).Copy
End With
End Sub
The simplest & dirtiest solution is this one:
Range("O2:O" & Cells(Rows.Count, "A").End(xlUp).Row).Copy
or you can isolate the last row as a separate variable:
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("O2:O" & lastRow).Copy
at the end, one may decide to declare the range to be copied as a separate variable and to work with it, declaring the parent worksheet as well:
Public Sub TestMe()
Dim lastRow As Long
Dim ws As Worksheet
Dim rangeToCopy As Range
Set ws = workshetes("Sheet1")
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rangeToCopy = .Range("O2:O" & lastRow)
rangeToCopy.Copy
End With
End Sub
And going really one step further is using a dedicated function for finding the last row per worksheet (GitHub repo here):
Function lastRow(wsName As String, Optional columnToCheck As Long = 1) As Long
Dim ws As Worksheet
Set ws = Worksheets(wsName)
lastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row
End Function
At some point, your code will have to know the range that's going to be copied, right? You assign that to a variable and you use it.
Option Explicit
Sub Test()
Dim startRow as Long
startRow = 'your method of determining the starting row
Dim startCol as Long
startCol = 'your method of determining the starting column
Dim endRow as Long
endRow = 'your method of determining the ending row (Last used row would work just fine)
Dim endCol as Long
endCol = 'your method of determining the ending column
With Worksheets("Data")
.Range(.Cells(startRow, startCol), .Cells(endRow, endCol)).Copy
End with
End Sub
you could use a Function you pass the "seed" range to and returning a range from passed one to the last not empty cell in the same column, as follows (explanations in comments)
Function GetRange(rng As Range) As Range
With rng.Parent ' reference passed range parent worksheet
Set GetRange = .Range(rng, .Cells(.Rows.Count, rng.Column).End(xlUp)) ' return referenced sheet range from passed range to passed range column last not empty cell
End With
End Function
to be used as follows:
Sub Test()
GetRange(Worksheets("Data").Range("O2")).Copy
End Sub
you could enhance the function and have it handle a given "final" row
Function GetRange(rng As Range, Optional finalRow As Variant) As Range
With rng.Parent ' reference passed range parent worksheet
If IsMissing(finalRow) Then ' if no "final" row passed
Set GetRange = .Range(rng, .Cells(.Rows.Count, rng.Column).End(xlUp)) ' return referenced sheet range from passed range to passed range column last not empty cell
Else 'else
Set GetRange = .Range(rng, .Cells(finalRow, rng.Column)) ' return referenced sheet range from passed range to passed range column cell in give "final" row
End If
End With
to be used as follows:
Sub Test()
GetRange(Worksheets("Data").Range("O2"), 2).Copy
End Sub
having kept "final" row as optional, the function can be used with or without passing it:
Sub Test()
GetRange(Worksheets("Data").Range("O2")).Copy ' this will copy worksheet "Data" range from row 2 down to its column "O" last not empty row
GetRange(Worksheets("Data").Range("O2"), 3).Copy ' this will copy worksheet "Data" range from row 2 down to row 3
End Sub
You clearly don't enjoy using variables, so:
Worksheets("Data").Range("O2", Worksheets("Data").Range("O" & Cells(Rows.Count, "A").End(xlUp).Row)).copy
would suffice.
Generally, a more common solution would be to use intersect and CurrentRegion:
Application.intersect(Worksheets("Data").Range("O2").CurrentRegion,Worksheets("Data").Range("O2:O999999")).copy
I'm practising VBA and I need some help / correction for my code.
In this task I'm creating a search tool which looks up each worksheet for the selected value from a combobox. Each result is listed on the first page.
Problems:
In the code I defined the .Find method in to a range rFound. On each worksheet the searched value is at column D. I would like to copy the row from column B to E. I've commented an attempt how did I tried to select that range, with offset but I receive an error. Why and how to fix that?
When I want to paste (list) the results I want it to start from the 1st page 3rd row column K. After running the code it selects the right target but pastes nothing. How to fix this?
I've also made some attempts to copy the document header after each search result, but I commented them out, please ignore lines with getOwner.
Dim ws As Worksheet, OutputWs As Worksheet, wsLists As Worksheet
Dim rFound As Range ', getOwner As Range
Dim strName As String
Dim count As Long, LastRow As Long
Dim IsValueFound As Boolean
'Dim cboSelectName As ComboBox
Dim a As String
IsValueFound = False
Set OutputWs = Worksheets("Teszt") '---->change the sheet name as required
LastRow = OutputWs.Cells(Rows.count, "A").End(xlUp).Row
Set wsLists = Worksheets("Lists")
a = ComboBox1.Value
On Error Resume Next
strName = a
If strName = "" Then Exit Sub
For Each ws In Worksheets
If ws.Name <> "Output" Then
With ws.UsedRange
Set rFound = .Find(What:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Not rFound Is Nothing Then
Application.Goto rFound, True
IsValueFound = True
'MsgBox rFound.Row
rFound.EntireRow.Copy
'Rfound keres - rFound.Range(rFound(Offset(-2,")),rFound.Offset(1,"")).Copy ' ---> This is a suggestion
OutputWs.Cells(LastRow + 2, 11).PasteSpecial xlPasteAll
'getOwner.Range(K2, R2).Copy ' attempt to copy the header for each search result
'getOwner.Cells(LastRow + 1, 6).Paste
Application.CutCopyMode = False
LastRow = LastRow + 1
End If
End With
End If
Next ws
On Error GoTo 0
If IsValueFound Then
OutputWs.Select
MsgBox "Search Complete!"
Else
MsgBox "Value not found"
End If
You are selection entire row but you are pasting it to the column K. If you copy entire row, you can only copy it to column A. That's why it is not working. So I suggest you to work on Offset part.
In Offset, first part is rows, second part is columns.
you can do something like that,
Dim sth as Range
set sth = .range(.rfound.offset(0,-2),.rfound.offset(0,1)).copy
But I am not sure of it. Not very good at that.
Hi can anyone figure out why I am getting this message..
run time error '1004' Application-defined or object-defined error
Here is my code, the problem line seems to be:
range("A1").Select
here is the rest of the code:
Sub HorizontalLoop()
Dim lCol As Long
Sheets("output").Select
For lCol = 1 To 100
Dim inputrange As String
If Not IsEmpty(Cells(lCol).Value) Then
inputrange = Cells(1, lCol).Value
ActiveCell.EntireColumn.Select
Selection.Copy
Sheets("input").Select
range("A1").Select
ActiveSheet.Paste
Sheets("output").Select
End If
Next lCol
End Sub
Thank you in advance :)
You need to qualify the Range("A1") with the the worksheet name (as mentioned in Paul Ogilvie's comment.
But you don't need to switch back and forth between the worksheets to paste. After the "copy" you can just add the "Destination".
I did a cut down version of your code (just 2 columns) so you can see what I mean:
Sub HorizontalLoop2()
Dim lCol As Long
Dim inputrange As String
Dim wsO As Worksheet
Dim wsI As Worksheet
Set wsO = ThisWorkbook.Worksheets("output")
Set wsI = ThisWorkbook.Worksheets("input")
For lCol = 1 To 2
If Not IsEmpty(wsO.Cells(lCol).Value) Then
inputrange = wsO.Cells(lCol).Value
wsO.Columns(lCol).Copy _
Destination:=wsI.Cells(1, lCol)
End If
Next lCol
End Sub
This assumes of course that you want to paste to the same column number!
Assuming that Cell A13 is Active cell in worksheet output, see the below code
worksheets("output").Range("A13").Activate
ActiveCell.EntireColumn.Copy Worksheets("input").Range("A1")
it will copy the entire column and paste it to the worksheet input
I have the following code:
Sub test()
Dim r As Range, rng As Range
Set r = Range("a6", Range("a6").End(xlDown))
For Each rng In r
If rng <> rng.Offset(-1) Then 'if range is not
Dim ws As Worksheet
Set ws = Worksheets.Add
ws.Name = rng
Else
End If
Next rng
End Sub
This would go through the range in A6 to AXX and create a worksheets for different names. I somehow can't figure out however how to copy the content of every row into every worksheet created.
So I want all the Ticker changes being copied into the new created worksheet ticker changes.
I know there is some way with the following:
Range(Cells(rng, 1), Cells(rng, 10)).Copy
But I don't know how to paste those to different worksheet.
Can someone please advice or guide. Thanks
Also when I try to run this macro it sometimes says:
That name is already taken try a different one.
However there is no worksheet with that name.
You only need to reference/specify the sheet that you want to use.
Try this (I included an inputbox to correct the name of the sheet if it is already taken :
Sub test_Nant()
Dim r As Range, rng As Range, ws As Worksheet, aWs As Worksheet
Set aWs = ActiveSheet
Set ws = Worksheets.Add
On Error GoTo SheetRename
ws.Name = "Changes list"
GoTo KeepLooping
SheetRename:
ws.Name = InputBox("Choose another name for that sheet : ", , rng.Value)
Resume Next
KeepLooping:
With aWs
Set r = .Range(.Range("a6"), .Range("a6").End(xlDown))
For Each rng In r
If rng <> rng.Offset(-1) Then 'if range is not
.Range(.Cells(rng.Row, 1), .Cells(rng.Row, 10)).Copy Destination:=ws.Range("A1")
Else
End If
Next rng
End With
End Sub
I am trying to loop through all the worksheets in the activeworkbook to perform a repetitive task.
I currently have the code below:
Sub sort_sectors()
Dim i As Integer
Dim rng As Range
Dim SortRng As Range
Dim rng1 As Integer
Dim ws As Worksheet
Dim wb As Workbook
Dim LastCol As Long
Dim LastRow As Long
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
'This is marking several of the sheets of which I do not want to run the sub
If ws.Range("a9").Value = "x" Then
NextIteration:
End If
'Reference point is rng1 to select the desired range
With Range("a1:t100")
rng1 = .Find(what:="sector", LookIn:=xlValues).Row
End With
'return the row number for the sector header
LastCol = ws.Cells(20, ws.Columns.Count).End(xlToLeft).Column
LastRow = ws.Range("a15").End(xlDown).Row
'I am going to add the code below to finish out the task that I want to complete
Next
End Sub
I am sure the problem is that I'm misunderstanding something about how the for each loop actually works. Hopefully someone's answer will allow to better understand.
I really appreciate any help on this.
I made some edits to the code, and now I actually do have an error :) I tried making the changes you suggested for the "with ws.range etc..." piece of the code, and I get the object error 91.
Below is my new and "improved" code.
Sub sort_sectors()
Dim i As Integer
Dim rng As Range
Dim SortRng As Range
Dim intAnchorRow As Integer
Dim intMktCapAnchor As Integer
Dim intSectorAnchor As Integer
Dim ws As Worksheet
Dim wb As Workbook
Dim LastCol As Long
Dim LastRow As Long
Set wb = ActiveWorkbook
For Each ws In ActiveWorkbook.Worksheets
'Filter out the sheets that we don't want to run
If ws.Range("a9").Value <> "x" Or ws.Name = "__FDSCACHE__" Or ws.Name = "INDEX" Then
'Get the anchor points for getting sort range and the sort keys
''''''THIS IS THE PART THAT IS NOW GIVING ME THE ERROR'''''''
With ws.Range("a1:t100")
intAnchorRow = .Find(what:="sector", LookIn:=xlValues).Row
intSectorAnchor = .Find(what:="sector", LookIn:=xlValues).Column
intMktCapAnchor = .Find(what:="Market Cap", LookIn:=xlValues).Column
End With
'Find the last row and column of the data range
LastCol = ws.Cells(20, ws.Columns.Count).End(xlToLeft).Column
LastRow = ws.Range("a15").End(xlDown).Row
Set SortRng = Range(Cells(intAnchorRow + 1, 1), Cells(LastRow, LastCol))
Range(SortRng).Sort key1:=Range(Cells(intAnchorRow + 1, intSectorAnchor), Cells(LastRow, intSectorAnchor)), _
order1:=xlAscending, key2:=Range(Cells(intAnchorRow + 1, intMktCapAnchor), Cells(LastRow, intMktCapAnchor)), _
order2:=xlDescending, Header:=xlNo
End If
Next
End Sub
Thanks again. This has been very helpful for me.
If I've understood your issue correctly, you don't want to use a worksheet with an x in cell A9.
If that's the case I would change the condition of the if statement to check if the cell does not contain the x. If this is true, it enters the rest of the code. If not, it goes to the next iteration.
Also, your NextIteration: doesn't do anything in the If statement.
Sub sort_sectors()
Dim i As Integer
Dim rng As Range
Dim SortRng As Range
Dim rng1 As Integer
Dim ws As Worksheet
Dim wb As Workbook
Dim LastCol As Long
Dim LastRow As Long
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
'This is marking several of the sheets of which I do not want to run the sub
If ws.Range("a9").Value <> "x" Then
'Reference point is rng1 to select the desired range
With Range("a1:t100")
rng1 = .Find(what:="sector", LookIn:=xlValues).Row
End With
'return the row number for the sector header
LastCol = ws.Cells(20, ws.Columns.Count).End(xlToLeft).Column
LastRow = ws.Range("a15").End(xlDown).Row
'I am going to add the code below to finish out the task that I want to complete
End If
Next
End Sub
The : operator is used to return the code to that line after a goto call.
For example
sub gotoEx()
for i = 1 to 10
if i = 5 then
goto jumpToHere
end if
next i
jumpToHere: '<~~ the code will come here when i = 5
'do some more code
end sub
And of course you can use this structure in your code if you wish, and have the jumpToHere: line just before the next
e.g.
for each ws in wb.Worksheets
if ws.Range("a9").Value = "x" then
goto jumpToHere
end if
'the rest of your code goes here
jumpToHere:
next