VBA - Get name of last added sheet - excel

I am looking for a code to get the name of the last added sheet to Excel.
I have tried this...
Sub test()
Dim lastAddedSheet As Worksheet
Dim oneSheet As Worksheet
With ThisWorkbook
Set lastAddedSheet = .Sheets(1)
For Each oneSheet In .Sheets
If Val(Mid(oneSheet.CodeName, 6)) > Val(Mid(lastAddedSheet.CodeName, 6)) Then
Set lastAddedSheet = oneSheet
End If
Next oneSheet
End With
MsgBox lastAddedSheet.Name & " was last added."
End Sub
But it does not really work.

You can't reliably know what sheet was last added, because a sheet can be inserted before or after any existing sheet in a workbook, see Sheets.Add documentation.
Unless you're the one adding it. In which case, all you need to do is capture the Worksheet object returned by the Add method:
Dim newSheet As Worksheet
Set newSheet = wb.Worksheets.Add
Debug.Print newSheet.Name
Extracting the digits from the CodeName isn't going to be reliable either - especially if you assume that every sheet's code name begins with 5 letters. On a German machine, the CodeName of what we see as Sheet1 would be Tabelle1 - but then again the role of that digit is strictly to ensure uniqueness of the names of the VBComponent items in the VBA project, and none of it says it has anything to do with any sort of ordering.

As per #MathieuGuindon his answer, I can't think of any "simple" way to safely return the name of the latest added sheet. However if you willing to sacrifice some designated space in your project to store CodeNames you could try to utilize the Workbook_NewSheet event.
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim lr As Long
With Sheets("Blad1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(lr, 1) = ActiveSheet.CodeName
End With
End Sub
Obviously you need to optimize this to add names when adding sheets during runtime. In this simplified example I manually added the existing sheet "Blad1", and upon adding new sheets, the list grew.
When deleting you can utilize the SheetBeforeDelete event, like so:
Private Sub Workbook_SheetBeforeDelete(ByVal Sh As Object)
Dim ws As Object
Dim lr As Long, x As Long
Dim rng1 As Range, rng2 As Range, cl As Range
With Sheets("Blad1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
Set rng1 = .Range("A2:A" & lr)
For Each ws In ActiveWindow.SelectedSheets
For Each cl In rng1
If cl = ws.CodeName Then
If Not rng2 Is Nothing Then
Set rng2 = Union(rng2, cl)
Else
Set rng2 = cl
End If
End If
Next cl
Next ws
End With
If Not rng2 Is Nothing Then
rng2.Delete
End If
End Sub
Now to get the latest added sheet we can refer to the last cell in our designated range:
Sub LastAdded()
Dim lr As Long
With ThisWorkbook.Sheets("Blad1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
Debug.Print "Last added sheet is codenamed: " & .Cells(lr, 1)
End With
End Sub
My take on it is that it would be safest to use the CodeName since they are least likely to get changed and are unique. We can also safely keep using our rng variable since there will always be at least one worksheet in your project (and that might just be the designated one if you protect it). Working in this project will now keep track of latest added worksheet.

Sheets could be a Chart or a Worksheet.
You could try use Worksheets instead of Sheets in your code.
sub test()
Dim lastAddedSheet As Worksheet
Dim oneSheet As Worksheet
With ThisWorkbook
Set lastAddedSheet = .WorkSheets(1)
For Each oneSheet In .WorkSheets
If Val(Mid(oneSheet.CodeName, 6)) > Val(Mid(lastAddedSheet.CodeName, 6)) Then
Set lastAddedSheet = oneSheet
End If
Next oneSheet
End With
MsgBox lastAddedSheet.Name & " was last added."
End Sub

Related

Move a full row of data with formatting and formulas to a designated sheet with one click

I have been an Excel-user for decades by now, VBA has been "out there" but nothing I've spent much time on in the past. Only minor alterations on existing scripts etc.
However I wanted to increase my knowledge and after about a month of tutorials, googling and more googling I feel that I'm getting a slight grip on the case.
I have a large workbook with many products, including specs, pricing and assorted calculation. When a products expires I'd like to move it to a EOL-sheet so I keep a log of old products.
Currently, this script is as far as I have come. It should look at the selected rows, and move the content to sheet "EOL" and delete it from the original sheet, and skip all hidden rows.
It works well if I select one cell, however if I select more cells, it doesn't correctly iterate through the full range.
Sub MoveRows()
Call SpeedUp
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim LastRow As Long
Dim rng As Range
Set rng = Selection
Set SouceSheet = ActiveSheet
Set TargetSheet = ActiveWorkbook.Sheets("EOL")
TargetRow = ActiveCell.row
LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "D").End(xlUp).row + 1
For Each row In rng.Rows
If row.Rows.Hidden Then
TargetRow = TargetRow + 1
Else
ActiveSheet.Rows(TargetRow).Copy
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormulasAndNumberFormats
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormats
Rows(TargetRow).EntireRow.Delete
LastRow = LastRow + 1
End If
Next row
Call SpeedDown
End Sub
*Note: the SpeedUp/SpeedDown function is to turn of screnupdating etc for efficiency. Doesn't affect the script itself. *
As I tested it commenting out the delete function, it copied the first cell repeatedly, obviously since TargetRow didn't change. When I added TargetRow = TargetRow + 1 after the End If it works flawlessly.
However, when I uncomment the delete part, it doesn't work as I would expect.
As TargetRow is deleted, then I would think that the next row would be the new TargetRow, but it seems like this doesn't happen.
I guess my problem is that there is no direct link between TargetRow and the iteration of rng.Rows, but how can I solve this?
Is there a way to store all the moved rows in a list and subsequently delete them through a new iteration ? Or maybe that is a bit too "python-thinking" for VBA .. ?
Appreciate all input on this probably fairly newbie question :)
You're use a For Each, but you hardly ever use row except for when you want to check if it's hidden. Why do you need TargetRow at all? Try:
For Each row In rng.Rows
If Not row.Rows.Hidden Then
row.Copy
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormulasAndNumberFormats
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormats
row.EntireRow.Delete
LastRow = LastRow + 1
End If
Next row
Move Visible Rows of the Selection
BTW, if you would have used Option Explicit, it would have warned you about the undeclared variable row and the typo in Set SouceSheet = ActiveSheet.
The Row property usually uses the capital letter R. In your code, there are occurrences of .row because you are using a variable named row. To make the case of the property capital again, declare Dim Row As Range. Then you could use another variable name instead of Row e.g. rrg (Row Range), srrg...
Option Explicit
Sub MoveRows()
If Selection Is Nothing Then Exit Sub ' no visible workbooks open
If Not TypeOf Selection Is Range Then Exit Sub ' not a range
Dim sws As Worksheet: Set sws = Selection.Worksheet
Dim srg As Range: Set srg = Intersect(Selection.EntireRow, sws.UsedRange)
If srg Is Nothing Then Exit Sub ' not in rows of the used range
Dim svrg As Range
On Error Resume Next
Set svrg = srg.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If svrg Is Nothing Then Exit Sub ' no visible cells
Dim dws As Worksheet
On Error Resume Next
Set dws = sws.Parent.Sheets("EOL")
On Error GoTo 0
If dws Is Nothing Then Exit Sub ' worksheet 'EOL' doesn't exist
Dim dfcell As Range
With dws.UsedRange
Set dfcell = dws.Cells(.Row + .Rows.Count, "A")
End With
Application.ScreenUpdating = False
svrg.Copy
dfcell.PasteSpecial xlPasteFormulasAndNumberFormats
dfcell.PasteSpecial xlPasteFormats
svrg.Delete xlShiftUp
Application.ScreenUpdating = True
MsgBox "Rows moved.", vbInformation
End Sub
UPDATE *
So after lots of time spent I did finally get to a solution which does the trick.
Sub MoveRows()
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim rng As Range
Dim TargetRow As Integer
Dim StartRow As Integer
Dim EndRow As Integer
Dim LastRow As Long
Set rng = Selection
Set SourceSheet = ActiveSheet
Set TargetSheet = ActiveWorkbook.Sheets("EOL")
LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "D").End(xlUp).row + 1
StartRow = rng.row
EndRow = rng.Rows.Count + StartRow - 1
For i = EndRow To StartRow Step -1
If Not Rows(i).Hidden Then
ActiveSheet.Rows(i).Copy
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormulasAndNumberFormats
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormats
Rows(i).EntireRow.Delete
LastRow = LastRow + 1
End If
Next i
Cells(EndRow, 1).Select
End Sub
Thanks to all for the help!

copy and pasting data to another worksheet with loop and if condition

The following code seems to run smoothly but nothing was copied onto the desired page
Sub a2()
Sheets.Add.Name = "25 degree"
Sheets("25 degree").Move after:=Sheets("data")
Dim x As Long
For x = 2 To 33281
If Cells(x, 1).Value = 25 Then
Cells("x,1:x,2:x,3:x,4:x,5:x,6").Copy
Worksheets("25 degree").Select
ActiveSheet.Paste
End If
Next x
End Sub
I highly recommend not to use .Select or ActiveSheet instead specify the sheet for each Cells() object according to How to avoid using Select in Excel VBA.
Option Explicit
Public Sub DoSomeCoypExample()
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.ActiveSheet
'better define by name
'Set wsSource = ThisWorkbook.Worksheets("source sheet")
Dim wsDestination As Worksheet
Set wsDestination = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets("data")) 'add at the correct position and set it to a variable
wsDestination.Name = "25 degree" 'so you can use the variable to access the new added worksheet.
Dim iRow As Long
For iRow = 2 To 33281 'don't use fixed end numbers (see below if you meant to loop until the last used row)
If wsSource.Cells(iRow, 1).Value = 25 Then
With wsSource
.Range(.Cells(iRow, 1), .Cells(iRow, 6)).Copy Destination:=wsDestination.Range("A1")
'this line will copy columns 1 to 6 of the current row
'note you need to specify the range where you want to paste
'if this should be dynamic see below.
End With
End If
Next iRow
End Sub
If you want to loop until the last used row you can get that with something like
Dim LastRow As Long
LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row 'last used row in column A
If you want to paste into the next free row in your destination worksheet instead of a fixed range Destination:=wsDestination.Range("A1") you can use the same technique as above to finde the next free row:
Dim NextFreeRow As Long
NextFreeRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
So you can use that in your paste destination:
Destination:=wsDestination.Range("A" & NextFreeRow)

Finding last cell with content in a column -> why is my version of the code giving an error?

I want to find the last cell containing information in a specific column and have found the below listed solution in another thread. However I tried to do it without defining 'ws as Worksheet'.
If I do this, the compiler does not accept '.Rows' within .cells(). Why?
Additional question:
In the first version, what does 'Set' do exactly? Why do i need this?
Code found in thread:
Sub testprint_UtilAnal()
Dim ws As Worksheet
Dim xrowrange As Range
Dim xrowprint As Long
Set ws = Sheets("Database_UtilAnal")
With ws
Set xrowrange = .Cells(.Rows.Count, "B").End(xlUp)
Set xrowprint = xrowrange.Rows
End With
End Sub
My code:
Sub testprint_UtilAnal_Alt()
Dim xrowrange As Range
Dim xrowprint As Long
xrowrange = Sheets("Database_UtilAnal").Cells(.Rows.Count, "B").End(xlUp)
xrowprint = xrowrange.Rows
End Sub
Last Cell/Row in Column
Like you use Set for workbooks and worksheets, you have to use it for other objects, too, e.g. ranges.
If you need the last cell (object) in column "B", you can use this:
Sub testprint_UtilAnal()
Dim xRowRange As Range
With Sheets("Database_UtilAnal")
Set xRowRange = .Cells(.Rows.Count, "B").End(xlUp)
End With
Debug.Print xRowRange.Address
Set xRowRange = Nothing
End Sub
If you need only the last row (number), you can use this:
Sub testprint_UtilAnal()
Dim xRowPrint As Long
With Sheets("Database_UtilAnal")
xRowPrint = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Debug.Print xRowPrint
End Sub
The following two versions demonstrate how to get one by using the other:
Sub testprint_UtilAnal()
Dim xRowPrint As Long
Dim xRowRange As Range
With Sheets("Database_UtilAnal")
Set xRowRange = .Cells(.Rows.Count, "B").End(xlUp)
xRowPrint = xRowRange.Row
End With
Debug.Print xRowRange.Address
Debug.Print xRowPrint
Set xRowRange = Nothing
End Sub
Sub testprint_UtilAnal()
Dim xRowPrint As Long
Dim xRowRange As Range
With Sheets("Database_UtilAnal")
xRowPrint = .Cells(.Rows.Count, "B").End(xlUp).Row
Set xRowRange = .Cells(xRowPrint, "B")
End With
Debug.Print xRowPrint
Debug.Print xRowRange.Address
Set xRowRange = Nothing
End Sub
The reason your code is not executing is because of Sheets("Database_UtilAnal").Cells(.Rows.Count, "B").End(xlUp)
The failing piece being .Rows.Count
The best way to imagine this is by visualizing a With statement. For all sakes and purposes, you can say that a With statement will append the parameter of said statement to any leading "."
That is to say
With ThisWorkbook.Worksheets(1)
.Range("A1")
End With
Is the same as
ThisWorkbook.Worksheets(1).Range("A1")
So why doesn't Sheets("Database_UtilAnal").Cells(.Rows.Count, "B").End(xlUp) execute successfully?
Notice the leading "." at .Rows.Count. Without a With statement, the compiler doesn't see anything to append to that, and therefore it cannot execute.
EDIT:
The Set keyword is used to assign objects (such as Range("A1")) to certain non-primitive datatypes (such as a Range).

excel vba: Range gives Argument Not Optional error message

In excel vba I'm tryin to select a range of values starting in Cell"O2", (O from Oyster) down to the end of the sheet,
I'm trying:
Range("O2", Range.End(xlDown))
But that fails with Argument Not Optional. What am i doing wrong?
I'm using Excel 2010.
Don't use xlDown Declare your Objects and then work with it.
Use this
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LRow As Long
Dim rng As Range
'~~> Change this to the relevant sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find last row in Col O which has data
LRow = .Range("O" & .Rows.Count).End(xlUp).Row
'~~> This is your range
Set rng = .Range("O2:O" & LRow)
With rng
'~~> Whatever you want to do
End With
End With
End Sub
To select the range from O2 to the last filled cell in that column, you could use:
Range("O2", Range("O2").End(xlDown)).Select
But that has a few problems, including the fact that it will "stop" at any blanks, and that you should avoid using Select unless absolutely necessary. Also, you should get in the habit of qualifying your ranges, e.g., specifying which worksheet they're in. Given all that, I propose something like this, assuming you wanted to turn the cells in the range red:
Sub test()
Dim LastRow As Long
Dim ws As Excel.Worksheet
Set ws = ActiveSheet
With ws
LastRow = .Range("O" & .Rows.Count).End(xlUp).Row
.Range("O2:O" & LastRow).Interior.Color = vbRed
End With
End Sub
Maybe you need
Range("O2", Range("O2").End(xlDown)).Select
?

How to copy cells downwards without overwriting what's under it?

https://dl.dropbox.com/u/3327208/Excel/copydown.xlsx
This is the sheet if you can't view dropbox.
This is the workbook. What I'm looking to do is where it shows 3M, copy the title of the company down to where it shows Total in Column A, and do the same with the next company.
How do I do this in Excel VBA? I know I can use the last row, but it's not exactly the best way for this I believe, because the original version will have over 300 different companies.
Here is the original code I am using for now. Without the extra bits added in.
Option Explicit
Sub Import()
Dim lastrow As Long
Dim wsIMP As Worksheet 'Import
Dim wsTOT As Worksheet 'Total
Dim wsSHI As Worksheet 'Shipped
Dim wsEST As Worksheet 'Estimate
Dim wsISS As Worksheet 'Issued
Dim Shift As Range
Set wsIMP = Sheets("Import")
Set wsTOT = Sheets("Total")
Set wsSHI = Sheets("Shipped")
Set wsEST = Sheets("Estimate")
Set wsISS = Sheets("Issued")
With wsIMP
wsIMP.Range("E6").Cut wsIMP.Range("E5")
wsIMP.Range("B7:G7").Delete xlShiftUp
End Sub
Matt, I had a great function for this a few months back, but I forgot to copy into my library. However, I've done a pretty good mock-up of what I had before. (I was using it to fill down entries in a pivot table for some reason or other).
Anyway, here it is. You may need to tweak it to meet your exact needs, and I am not claiming it's not prone to any errors at the moment, but it should be a great start.
EDIT = I've updated my code post to integrate into yours to make it easier for you.
Sub Import()
Dim lastrow As Long
Dim wsIMP As Worksheet, wsTOT As Worksheet 'Total
Dim wsSHI As Worksheet, wsEST As Worksheet 'Estimate
Dim wsISS As Worksheet, Shift As Range
Set wsIMP = Sheets("Import")
Set wsTOT = Sheets("Total")
Set wsSHI = Sheets("Shipped")
Set wsEST = Sheets("Estimate")
Set wsISS = Sheets("Issued")
With wsIMP
.Range("E6").Cut .Range("E5")
.Range("B7:G7").Delete xlShiftUp
Call FillDown(.Range("A1"), "B")
'-> more code here
End With
End Sub
Sub FillDown(begRng As Range, col As String)
Dim rowLast As Long, rngStart As Range, rngEnd As Range
rowLast = Range(col & Rows.Count).End(xlUp).Row
Set rngStart = begRng
Do
If rngStart.End(xlDown).Row < rowLast Then
Set rngEnd = rngStart.End(xlDown).Offset(-1)
Else
Set rngEnd = Cells(rowLast, rngStart.Column)
End If
Range(rngStart, rngEnd).FillDown
Set rngStart = rngStart.End(xlDown)
Loop Until rngStart.Row = rowLast
End Sub
enter code here
As long as there are no formulas you don't want to overwrite...
EDIT - updated to set original range based off end of column B
Sub Macro1()
Dim sht as WorkSheet
Set sht = ActiveSheet
With sht.Range(sht.Range("A7"), _
sht.Cells(Rows.Count, 2).End(xlUp).Offset(0, -1))
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub

Resources