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
Related
I keep having troubles with "Error 1004 - Method 'Name' of object '_Worksheet'" in my VBA macro.
Basically the idea of this macro is to check the cells of a column (containing strings) and to compare them to the names of the worksheets of my workbook.
If there is a cell whose value doesn't appear among the names of the worksheets, the macro should create a new worksheet and rename it after the value inside the cell.
For j = (RowStart + 1) To 500
'allocate the value of the reference cell in cell_content
cell_content = Worksheets("Worksheet1").Cells(j, ColStart).Value
Switch = 0
'check if cell_content appears as the name of one of the worksheet
For i = 1 To Sheets.Count
If cell_content = Sheets(i).Name Then
Switch = Switch + 1
End If
Next i
'if it does not, the macro creates a new worksheets with the name of cell_content
If Switch = 0 Then
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = cell_content
End If
Next j
Consider that ColStart and RowStart are just the reference values for the column under consideration and the variable Switch is used to define whether or not it is required to create a new worksheet.
The problem is that the very last part of the macro keeps giving me error 1004.
Does anyone know what can be the problem?
Thank you very much
I guess your workbook is locked. A small code like this works on an empty Excel:
Public Sub TestMe()
Dim ws As Worksheet
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Name = "CodeThatWorks"
End Sub
What may be the other possible reason that your code does not work is that the name is like this ws.Name = "BadNamesIncludeThese:]\?*[]", thus including special characters which are not allowed for a name in the worksheet.
I got some script here to open up multiple workbooks with a worksheet and then copy it to a worksheet as a loop, but I need an additional cell (the date) from another worksheet in the multiple workbooks because the output I got cannot be changed and just added to the same sheet.
What I need is for this code to include a single cell range from another sheet on the workbook and then fill it to the bottom of the range per workbook.
I cant use UNION as it's not the same length, and I looked up merging ranges into one, but I get type mismatch errors.
VBA: How to combine two ranges on different sheets into one, to loop through I tried this but I can't figure out how to put it into my code.
Here is the code I have that works so far for just the one range. The rngdate copies over but does not leave a gap or autofill to the next loop, it just pastes under each other, so maybe this code will work but I'm missing something basic like autofill?
Dim vFileNames As Variant
Dim y As Long
Dim wbTemp As Workbook
Dim wbNew As Workbook
Dim blHeader As Boolean
Dim Rng As Range
Dim rngDate As Range
Application.ScreenUpdating = False
Set wbNew = Workbooks("master_timesheet") '.Add
blHeader = False
vFileNames = Application.GetOpenFilename(Title:="Select all workbooks to copy", _
MultiSelect:=True)
'Will not be array if no file is selected
'If user selects one or more files, files will be stored as an array
If Not IsArray(vFileNames) Then GoTo ConsolidateWB_End
For y = LBound(vFileNames) To UBound(vFileNames)
'Open each wb selected
Set wbTemp = Workbooks.Open(vFileNames(y))
Set rngDate = wbTemp.Worksheets("Communications Unlimited Inc").Range("A5").CurrentRegion
Set Rng = wbTemp.Worksheets("Export").Range("A1").CurrentRegion
'If header row already copied, then offset by 1 to exclude header
If blHeader Then
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
'If header row not already copied, keep rng as is and change blHeader to true
Else
blHeader = True
End If
'Paste to next row on new wb
Rng.Copy Destination:=wbNew.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0)
rngDate.Copy Destination:=wbNew.Sheets(1).Range("P65536").End(xlUp).Offset(1, 0)
wbTemp.Close SaveChanges:=False
Next y
ConsolidateWB_End:
Application.ScreenUpdating = True
End Sub
If I read your problem correctly you want the date, rngdate, pasted adjacent to each and every line of data you have just copied. However your current code only puts the data on the first row. Below is an adaptation of how I have solved this problem myself, taking account of your existing code. (My guess is that there is a much more elegant solution than this which I'm just not aware.)
Dim pasterangefirstrow As Integer
...
pasterangefirstrow = wbNew.Sheets(1).Range("D65536").End(xlUp).Offset(1, 0).Row
...
With wbNewSheets(1)
Rng.Copy Destination:=.Range("D65536").End(xlUp).Offset(1, 0)
rngdate.Copy Destination:=.Range("P" & pasterangefirstrow & ":P" & pasterangefirstrow + Rng.Rows.Count - 1)
End With
I would like to copy a range of values from one worksheet into a specified range of another worksheet whereas values always come from the previous worksheet (in the worksheet row), even after duplicating the worksheet. I'm using the following to copy values from one worksheet to the other, which seems to work:
Sub Copy_ultimo_stock()
'copy values between two periods
Worksheets("Period2").Range("test3").Value = Worksheets("Period1").Range("test2").Value
End Sub
I had to give the range of cells a name (test2 and test3), because the macro wouldn't work if I use the actual cell range like "R10:S11". In the future however, I would just like to use the cell range as "R10:S11".
My actual problem however is the following. If I duplicate my worksheets in the future (for future periods), I want that I always copy the cell range from the previous worksheet. The way I have done it now, if I copy the worksheet period2, and call it maybe period6, it will still copy values from period1 worksheet. However, I would like that the current worksheet "n" will copy values from the range in worksheet "n-1".
I have found a somewhat similar approach that could help, but I couldn't combine both macros into one. That approach is here:
Function PrevSheet(rCell As Range)
Application.Volatile
Dim i As Integer
i = rCell.Cells(1).Parent.Index
PrevSheet = Sheets(i - 1).Range(rCell.Address)
End Function
EDIT
So you requirement is a macro that imports from "the previous sheet", so that when you click the button, the subroutine first fetches the previous from the current and accordingly fetches the values.
We will suppose that all Worksheets are named like "periodx", where x is an integer identifying the period. when we create a new worksheet copy, we need first to rename the new worksheet in the form "periodx" and then click on the button to fetch the values from the sheet "periody" where y = x-1.
Just replace your button handler Copy_ultimo_stock() with this one:
Sub Copy_ultimo_stock()
Dim wsCur As Worksheet, wsPrev As Worksheet
Set wsCur = ActiveSheet
' We will suppose that all Worksheets are named like "periodx"
' where x is an integer identifying the period
On Error Resume Next ' try fetching the previous ws as "periody" where y = x-1
Dim x As Integer: x = CInt(Mid(wsCur.Name, Len("period") + 1))
Set wsPrev = ThisWorkbook.Sheets("period" & (x - 1))
If Err.Number <> 0 Then
msgBox "Could not find the previous worksheet, Please check Worksheet names"
Exit Sub
End If
On Error GoTo 0
' Now we copy the previous values. You can customize the ranges if the design changes
wsCur.Range("D2:L8").Value = wsPrev.Range("D10:L16").Value
End Sub
Moreover, you can automate the generation of a new period worksheet by adding another button, say "Generate Next Period", that will create the new ws and give it the appropriate name. This will save the user the task of copying the sheet and renaming it. The code for the new button will be like this:
Sub create_next_period()
Dim wsCur As Worksheet, wsNext As Worksheet
Set wsCur = ActiveSheet
On Error Resume Next
Dim x As Integer: x = CInt(Mid(wsCur.Name, Len("period") + 1))
If Err.Number <> 0 Then
msgBox "Please check Worksheet name. It should be named periodx"
Exit Sub
End If
Set wsNext = ThisWorkbook.Sheets("period" & (x + 1))
If Err.Number = 0 Then
msgBox "The worksheet " & wsNext.Name & " already exists"
Exit Sub
Else
Err.Clear
wsCur.Copy After:=Worksheets(Worksheets.Count)
Set wsNext = Worksheets(Worksheets.Count)
wsNext.Name = "period" & (x + 1)
wsNext.Activate
Call Copy_ultimo_stock
End If
End Sub
When you name your cells do:
Range("whatever").name="Sheet!Name"
and not just
Range("whatever").name="Name"
==> this way you can gave the same named range on several sheets without any problem
Hope this helps.
However I wouldn't advice using too much named ranges...
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 have a list of values in a excel name range .I want to write a VB code so as to create worksheets using those list of values.These list of values keep on changing.
Here is the code:
Sub AddSheets()
Dim cell As Excel.Range
Dim wsWithSheetNames As Excel.Worksheet
Dim wbToAddSheetsTo As Excel.Workbook
Dim i As Integer
i = 0
Set wsWithSheetNames = ActiveSheet
Set wbToAddSheetsTo = ActiveWorkbook
For Each cell In wsWithSheetNames.Range("sheet_name").End(xlDown)
With wbToAddSheetsTo
.Sheets.Add after:=.Sheets(.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = cell.Value
If Err.Number = 1004 Then
Debug.Print cell.Value & " already used as a sheet name"
End If
On Error GoTo 0
End With
Next cell
Here sheet_name(cells in a single column) is the namerange where the name of the sheets to be created is dumped.
The no of sheets may change.
My above code does not work correctly , it just creates the a sheet with the sheet name of last value in this range.Where am i going wrong? I am new to VB.what may be a better way to do this?
This line:
For Each cell In wsWithSheetNames.Range("sheet_name").End(xlDown)
Get rid of the .End(xlDown), this is only grabbing the last value, as you said.
In naming the range, just using the name already has the entire range defined.
You are almost there. Notice the line below in your script, and just get rid of .End(xldown) at the end.
---For Each cell In wsWithSheetNames.Range("sheet_name").End(xlDown)-----
change to
---For Each cell In wsWithSheetNames.Range("sheet_name")-----
Then it will add the individual sheetname one after another.