My workbook has both chart sheets and normal sheets, therefore I am using Sheets instead of Worksheets. However, I don't know what the type of sht should be in the following set of codes. I am sure it cannot be Worksheet.
' Hide all sheets/charts except Sheet1
Sub Hide_Sheets()
Dim sht As ???
For Each sht In ActiveWorkbook.Sheets
If sht.Name <> Sheet3.Name Then
sht.Visible = False
End If
Next sht
End Sub
"Charts and Worksheets are two different collections." --> https://stackoverflow.com/a/6804704/138938
If you have both chart sheets and regular worksheets, you can either loop through a collection of objects like this:
Sub Hide_Objects()
Dim wb As Workbook
Dim obj As Object
Set wb = ActiveWorkbook
For Each obj In wb.Sheets
If obj.Name <> "Sheet1" Then
obj.Visible = False
End If
Next obj
End Sub
Or you can loop through both collections like this:
Sub Hide_Sheets_And_Charts()
Dim wb As Workbook
Dim sht As Worksheet
Dim cht As Chart
Set wb = ActiveWorkbook
For Each sht In wb.Worksheets
If sht.Name <> "Sheet1" Then
sht.Visible = False
End If
Next sht
For Each cht In wb.Charts
If cht.Name <> "Sheet1" Then
cht.Visible = False
End If
Next cht
End Sub
Use Variant then step through the code and you'll be able to see what it is.
Variant will work without doing anything else.
I recommend using real names for variables to make it easier for you to read your code at some stage in the future.
Sub Hide_Sheets()
Dim sheet_ As Variant
For Each sheet_ In ActiveWorkbook.Sheets
If sheet_.Name <> Sheet3.Name Then
sheet_.Visible = False
End If
Next sheet_
End Sub
Related
I have a multitude of sheets in my workbook. I want to hide some of them. The primary criterion can be hiding them beyond the sheet with some specified name.
In my case, this is the sheet named BoM
I want everything to be hidden behind this worksheet.
What I tried is:
Sub Sheethidden()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name > "BoM" Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub
but it didn't work
Please, try the next way. You need to use the sheet Index as reference:
Sub Sheethidden()
Dim wsIndex As Long, i As Long
wsIndex = Worksheets("BoM").Index
For i = wsIndex + 1 To Worksheets.count
Worksheets(i).Visible = xlSheetHidden
Next i
End Sub
or you may keep your code and compare the sheets index:
Sub Sheethidden()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.index > Worksheets("BoM").Index Then
ws.Visible = xlSheetHidden
End If
Next ws
End Sub
Adapting your code, I would do as follow.
Public Sub HideSheetAfterName()
Const NAME_SHEET = "BoM"
Dim ws As Worksheet
Dim ws_pass As Boolean
ws_pass = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = NAME_SHEET Then ws_pass = True
If ws_pass Then ws.Visible = xlSheetHidden
Next ws
End Sub
Since you know Excel worksheets in ThisWorkbook.Worksheets are ordered by order they appear in the Excel workbook, I suggest just to check when you find the desired NAME_SHEET.
Additional suggestion: always use ThisWorkbook before Worksheet object in order to force using the current workbook.
I have tried to make this code but still having an issue.
Question is simple -
If sheet2 exists then
ThisWorkbook.Sheets(Sheet1).Range(a1).Select
If does not exist then
Set ws = Worksheets.Add(after:=Worksheets("Sheet1")) ws.Name = "Sheet2"
But after adding sheet2 it still gives error.
Below is the code:
Sub new6()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
If ws.Name <> "Sheet2" Then
Set ws = Worksheets.Add(after:=Worksheets("Sheet1"))
ws.Name = "Sheet2"
Else
ThisWorkbook.Sheets(Sheet1).Range(a1).Select
End If
Next
End Sub
I think you need to change your approach and remove that loop entirely by implementing a great solution from #Tim Williams. The issue with your code is you are adding a new sheet before verifying if the sheet exists in the book.
Add the WorksheetExists function which will scan the entire workbook for a sheet without a loop and return WorksheetExists = TRUE or FALSE. From there you can simplify your macro by removing the loop and acting on the result of the function.
You can also avoid Select here with Application.Goto
Sub new6()
Dim ws As Worksheet
If WorksheetExists("Sheet2", ActiveWorkbook) Then
Application.Goto (Sheets("Sheet1").Range("A1"))
Else
Set ws = Worksheets.Add(After:=Worksheets("Sheet1"))
ws.Name = "Sheet2"
End If
End Sub
Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
WorksheetExists = Not sht Is Nothing
End Function
Before selecting the A1 range with ThisWorkbook.Sheets(Sheet1).Range(a1).Select, the correct sheet should be selected on the line before.
The second error is that Sheets collection expects a string. Thus:
ThisWorkbook.Sheets("Sheet1").Select
ThisWorkbook.Sheets("Sheet1").Range("a1").Select
For the code above, put a boolean variable, which tracks whether Sheet2 was found. If it was not found, then create a new Worksheet:
Sub new6()
Dim wb As Workbook
Dim ws As Worksheet
dim isFound As Boolean
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
If ws.Name <> "Sheet2" Then
'Do Nothing
Else
isFound = True
ThisWorkbook.Sheets("Sheet1").Select
ThisWorkbook.Sheets("Sheet1").Range("a1").Select
End If
Next
If Not isFound Then
Set ws = Worksheets.Add(after:=Worksheets("Sheet1"))
ws.Name = "Sheet2"
End If
End Sub
The code above will throw an error, if "Sheet1" does not exist. But you may try to make sure that it exists with a few additional lines.
In general - try to avoid Select - How to avoid using Select in Excel VBA.
And whenever having queries about Selecting cells in VBA, use the Macro Recorder, for the first couple of months its help will be useful.
I am currently using the following code to remove classifications I do not require in my tables:
Sub RemoveOldPlatforms()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("RAW")
ws.Range("$A$1:$J$100000").AutoFilter Field:=2, Criteria1:=Array("Coniferous", "Broafleaf", "Mixedwood", "Water", "Exposed Land / Barren", "Urban / Developed", "Greenhouses", "Shrubland", "Wetland", "Grassland"), Operator:=xlFilterValues
ws.Range("$A$2:$J$100000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws.Range("$A$1:$J$100000").AutoFilter
End Sub
As is, I am specifying a single identified worksheet, but how do I loop it through all worksheets in my workbook (20+)?
Hi pretty simple code to check every worksheets in a workbook,
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
'called once per worsheet
Next ws
Here I loop trough all the worksheet to find all tables availiable in ANOTHER workbook and display it inside a ComboBox
Private Sub UpdateTablesFromFile()
Dim wb As Workbook
Dim ws As Worksheet
Dim tbl As ListObject
Dim text As String
Dim I As Integer
Dim FileToOpen As String
FolderPath = Application.ActiveWorkbook.Path
FilePath = FolderPath & "\" & ComboBox1.Value
Application.ScreenUpdating = False
Workbooks.Open Filename:=FilePath
For Each ws In Workbooks(ComboBox1.Value).Worksheets
For Each tbl In ws.ListObjects
text = ws.Name & "\" & tbl.Name
ImportForm1.ComboBox2.AddItem text 'add every tables in my entire workbook inside the ComboBox2
Next tbl
Next ws
Workbooks(ComboBox1.Value).Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
You should do something like this:
Sub EnteringAllSheetsOneByOne()
For Each ws In Excel.Workbooks("YourWorkbook.xlsx").Worksheets
ws.Select
Call RemoveOldPlatforms(ws) 'must to be called here and use ws as parameter
Next ws
MsgBox "Done!"
End Sub
' Just add the "ws" parameter to your current sub
Sub RemoveOldPlatforms(ws As Object)
'Dim ws As Worksheet
'Set ws = ThisWorkbook.Worksheets("RAW")
ws.Range("$A$1:$J$100000").AutoFilter Field:=2, Criteria1:=Array("Coniferous", "Broafleaf", "Mixedwood", "Water", "Exposed Land / Barren", "Urban / Developed", "Greenhouses", "Shrubland", "Wetland", "Grassland"), Operator:=xlFilterValues
ws.Range("$A$2:$J$100000").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws.Range("$A$1:$J$100000").AutoFilter
End Sub
Note: Please pay atention to all I've commented, Dim and Set in this case are not necessary
I have two workbooks with worksheets (having the same names). I would like copy and paste specific cells from one worksheet to another if the name of worksheets are the same.
I tried to compare name of worksheets with array based on names from another workbook but stack when comes to comparison
Sub check()
Dim xArray, i
Dim x As Workbook
Dim ws As Worksheet
Set x = Workbooks.Open("C:\Users\user\Desktop\xxx.xlsx", False)
With x
ReDim xArray(1 To Sheets.Count)
For i = 1 To Sheets.Count
xArray(i) = x.Sheets(i).Name
Debug.Print xArray(i)
Next
End With
x.Close (False)
For Each ws In ThisWorkbook.Worksheets
If ws.Name = xArray Then
' copy for each worksheet define in xArray xxx.xlsx file, range A1,B4,D5:G5
' and paste to worksheet with the same name in this open workbook
End Sub
Thanks for any help !
Use an Error handler to test if the sheet exists.
Sub check()
Dim wb As Workbook, SouceWorksheet As Worksheet, TargetWorksheet As Worksheet
Set wb = Workbooks.Open("C:\Users\user\Desktop\xxx.xlsx", False)
For Each SouceWorksheet In wb.Worksheets
On Error Resume Next
Set TargetWorksheet = ThisWorkbook.Worksheets(SouceWorksheet.Name)
On Error GoTo 0
If Not TargetWorksheet Is Nothing Then
SouceWorksheet.Range("A1").Copy TargetWorksheet.Range("A1")
SouceWorksheet.Range("B4").Copy TargetWorksheet.Range("B4")
SouceWorksheet.Range("D5:G5").Copy TargetWorksheet.Range("D5:G5")
End If
Next
wb.Close False
End Sub
for this functionality , you don't need to create array , it can be done easily with simple logic mentioned below.Also you can customize or replace your workbook and worksheet name and your copy-paste range in the below code.
Sub so()
Dim wb As Workbook
Dim wb1 As Workbook
Set wb = Workbooks("Book1.xlsx")
Set wb1 = Workbooks("Book2.xlsx")
Dim wk As Worksheet
Set wk = wb.Worksheets("Sheet1")
Dim wm As Worksheet
Set wm = wb1.Worksheets("Sheet1")
If (wk.Name = wm.Name) Then
Dim TR As Integer
TR = wk.Range("A" & Rows.Count).End(xlUp).Row
wk.Range("A1:A" & TR).Copy wm.Range("A1")
Application.CutCopyMode = False
End If
End Sub
I want to copy/paste all worksheet inlcuding the values/formula in the cells to another new workbook.
This code just copy the first ws, but not all other. How can I make sure, that all ws are gettin copied and pasted without writing all the names from the ws in the vba-code?
Sub CopyPaste()
Dim ws As Worksheet, wb As Workbook
Set ws = ActiveSheet
Set wb = Workbooks.Add(xlWBATWorksheet)
ws.Range("A1:G10").Copy
wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub
So i assume you will be saving the second workbook for it to be named? therefore just add your path below where you want to save it, also it now retains the sheet names.
I'm not sure why you are getting a debugger error its working fine for me, try this code and see if you still get it?
Sub newworkbook()
Dim WBN As workbook, WBC As workbook, WB As workbook
Dim WS As String
Dim SHT As Worksheet
Set WBN = Workbooks.Add
For Each WB In Application.Workbooks
If WB.Name <> WBN.Name Then
For Each SHT In WB.Worksheets
SHT.Copy After:=WBN.Sheets(WBN.Worksheets.Count)
WBN.Sheets(WBN.Worksheets.Count).Name = (SHT.Name) & " "
Next SHT
End If
Next WB
Application.DisplayAlerts = False
WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
WBN.Application.DisplayAlerts = True
ActiveWorkbook.SaveAs "C:\YOURPATH\timetable_v2.xls" 'change path to whatever
End Sub
You can try as follow:
Sub CopyPaste()
Dim aSheet As Worksheet
Dim workbook As workbook
Dim index As Integer
Set workbook = Workbooks.Add(xlWBATWorksheet)
For Each aSheet In Worksheets
aSheet.Range("A1:G10").Copy
workbook.Sheets(index).Range("A1").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
index = index + 1
Application.CutCopyMode = False
Next aSheet
End Sub
Just had a quick look for you, this seems to do the job:
credit: get digital help
Dim WBN As Workbook, WBC As Workbook, WB As Workbook
Dim WS As String
Dim SHT As Worksheet
Set WBN = Workbooks.Add
For Each WB In Application.Workbooks
If WB.Name <> WBN.Name Then
For Each SHT In WB.Worksheets
SHT.Copy After:=WBN.Sheets(WBN.Worksheets.Count)
WBN.Sheets(WBN.Worksheets.Count).Name = Left(WB.Name, 30 - Len(SHT.Name)) & "-" & SHT.Name
Next SHT
End If
Next WB
Application.DisplayAlerts = False
WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
WBN.Application.DisplayAlerts = True
I just deleted WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
And it works fine
The new workbook is saved as an .xlsx file, but of course I Need it as an .xlsm file....when I just added it into the path, it doesnt work
ActiveWorkbook.SaveAs "U:\Excel\timetable_v2.xlsm"