I must jump between different excel sheets to grab data for my VBA to output what I want. I've been using the Sheets("name").Select function to jump between the sheets. Sometimes it works and lets me run the program, but other times I get a runtime error. I want this to work 100% of the time every time, and always get disheartened whenever it fails due to the select function. If anyone has any tips or recommendations I would love for you to share them! Any help would be greatly appreciated.
Sheets("Test").Select
Run-time Error '1004': Select Method of Worksheet Class Failed
Don't use Select (or Activate for that matter), it's bad practise and leads to errors rather quickly.
This thread is a great help as to why and how you should avoid using it.
There is no need to select a sheet before getting data from it. For example:
Sub test()
'''
'Bad practise:
'''
Sheets("Sheet1").Select
i = Range("A1")
'''
'Good practise
'''
i = Workbooks("Book1").Sheets("Sheet1").Range("A1").Value
'''
'Better practise
'''
Dim wb As Workbook
Dim sht As Worksheet
Dim i As String
Set wb = Workbooks("Book1")
Set sht = wb.Sheets("Sheet1")
With sht
i = .Range("A1").Value
End With
End Sub
With Statement:
Option Explicit
Sub test()
'Create a witrh statement with the Sheet name you want
With ThisWorkbook.Worksheets("Sheet1")
'Refer to cell A1 (don t forget the "." before Range)
.Range("A1").Value = ""
'Refer to cell A1 (don t forget the "." before Cells)
.Cells(1, 1).Value = ""
End With
End Sub
Loop Worksheets:
Option Explicit
Sub test()
Dim ws As Worksheet
'Loop Sheets
For Each ws In ThisWorkbook.Worksheets
With ws
'If sheet name is Sheet1 or Sheet3
If .Name = "Sheet1" Or .Name = "Sheet3" Then
'Refer to cell A1 (don t forget the "." before Range)
.Range("A1").Value = 2
'Refer to cell A1 (don t forget the "." before Cells)
.Cells(1, 1).Value = 10
ElseIf .Name = "Sheet2" Then
'Refer to cell A1 (don t forget the "." before Range)
.Range("A1").Value = 5
'Refer to cell A1 (don t forget the "." before Cells)
.Cells(1, 1).Value = 20
End If
End With
Next ws
End Sub
Set Worksheet To Variable
Option Explicit
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
With ThisWorkbook
Set ws1 = .Worksheets("Sheet1")
Set ws2 = .Worksheets("Sheet2")
End With
End Sub
Related
I am trying to hide the activecell column across first 4 tabs. The vba below does not seem to be working. It only hides the activecell in first tab in activesheet. So basically I select highlight first 4 tabs and select cell A1 then use below code:
ActiveCell.EntireColumn.Hidden = True
This only hides column A in first tab, but not tab 2,3,4. Can someone please help get the correct code? Just fyi...it has to be the selected cell and not Range("A1").EntireColumn.Hidden = True, because cell can be any active cell I am trying to hide using an offset function. Any help is appreciated. Thanks.
You could store the location of the active cell, then cycle through each worksheet and use that location to base your column hiding..
Sub tested()
Dim cell_address As String
Dim wsName, ws, c As Range
cell_address = ActiveCell.Address
wsName = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
For Each ws In wsName
Sheets(ws).Range(cell_address).EntireColumn.Hidden = True
Next
End Sub
Hide the Same Column in Different Worksheets
There is no way to combine (select) cells from multiple worksheets at the same time so you need to loop through the worksheets and hide each column separately, one after the other.
Usage
Sub HideCellColumnsTEST()
Dim wsIDs(): wsIDs = Array(1, 2, 3, 4)
Dim ws As Worksheet: Set ws = ActiveSheet
Dim cell As Range: Set cell = ws.Range("A1")
'or:
'Set cell = ActiveCell
'Set cell = ActiveCell.Offset(, 3) '...etc.
HideCellColumns cell, wsIDs
End Sub
The Method
Sub HideCellColumns(ByVal cell As Range, ByVal wsIDs As Variant)
Dim CellAddress As String: CellAddress = cell.Address
Dim wb As Workbook: Set wb = cell.Worksheet.Parent
Dim ws As Worksheet, wsID
For Each wsID In wsIDs
On Error Resume Next
Set ws = wb.Worksheets(wsID)
On Error GoTo 0
If Not ws Is Nothing Then ' worksheet exists
ws.Range(CellAddress).EntireColumn.Hidden = True
Set ws = Nothing ' reset for the next iteration
'Else ' worksheet doesn't exist; do nothing!?
End If
Next wsID
End Sub
So, say for instance I have 2 sheets in my workbook... Page1 and OldName.
On sheet Page1 in cell A1 there is the value OldName (where "OldName" happens to be sheet name of the sheet I would like to rename).
Also on Page1 in cell A2, there is the value NewName (where "NewName" is the name I would like to change the sheet specified in cell A1 to).
I am Trying to come up with code that uses the the cell A1 to identify which sheet I would like to rename and then use the cell A2 as the source for the rename value.
Any suggestions?
You may try something along these lines:
Sub Test()
Dim sht As Worksheet
With ThisWorkbook
For Each sht In .Worksheets
If sht.Name = .Worksheets("Page1").Cells(1, 1).Value Then
sht.Name = .Worksheets("Page1").Cells(2, 1).Value
Exit For
End If
Next
End With
End Sub
try this simple loop
Sub ChangeNameLoop()
Dim wb As Workbook
Dim ws As Worksheet
Dim OldName As String, NewName As string
Set wb = ThisWorkbook
OldName = ActiveSheet.Range("A1") ' location of names
NewName = ActiveSheet.Range("A2")
For Each ws In wb.Worksheets
If ws.Name = OldName Then
ws.Name = NewName
End If
Next ws
End Sub
No need to loop. This will do what you want. This code will replace the sheet name if found else will do nothing.
Option Explicit
Sub Sample()
On Error Resume Next
With ThisWorkbook
.Sheets(.Sheets("Page1").Cells(1, 1).Value2).Name = _
.Sheets("Page1").Cells(2, 1).Value2
End With
On Error GoTo 0
End Sub
Or something like this
Option Explicit
Sub Sample()
Dim ws As Worksheet
With ThisWorkbook
On Error Resume Next
Set ws = .Sheets(.Sheets("Page1").Cells(1, 1).Value2)
On Error GoTo 0
If Not ws Is Nothing Then ws.Name = _
.Sheets("Page1").Cells(2, 1).Value2
End With
End Sub
I would like to select multiple cells based on selection.
And here is my code:
Private Sub CommandButton1_Click()
Selection.EntireRow.Select
End Sub
I want to select the first four columns of rows in multiple cells, instead of the whole rows. How to achieve it?
this is my Excel worksheet
Select Rows of Non-Contiguous Range
Copy the codes into a standard module e.g. Module1.
In your command button click event use either of the procedure names in the following way:
Private Sub CommandButton1_Click()
selectRowsOfListObject
End Sub
or
Private Sub CommandButton1_Click()
selectRowsOfFirstFourColumns
End Sub
The first procedure will select only the rows of the selected cells in the first (structured) table in the ActiveSheet. Any cells outside the data of the table (DataBodyRange) will be ignored.
The second procedure will select all the row ranges of the selected cells in the first four columns, in the first four columns of the ActiveSheet. Any cells selected outside of the first four columns will be ignored
Each or both of the codes can be used with command buttons on any worksheet when they will refer to the worksheet 'containing' the command button.
If you want a command button on another worksheet to always refer to the first, you will rather have to create a reference to the first worksheet:
Instead of
Set ws = ActiveSheet
use e.g.
Set ws = wb.Worksheets("Sheet1")
To better understand the differences, you could add another command button for the second code and then test each of them.
The Code
Option Explicit
Sub selectRowsOfListObject()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects(1)
If Selection.Worksheet.Name = ws.Name Then
If TypeName(Selection) = "Range" Then
Dim rng As Range
Set rng = Intersect(Selection, tbl.DataBodyRange)
If Not rng Is Nothing Then
Set rng = Intersect(rng.Rows.EntireRow, tbl.DataBodyRange.Rows)
End If
If Not rng Is Nothing Then
rng.Select
End If
End If
End If
End Sub
Sub selectRowsOfFirstFourColumns()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = ActiveSheet
If Selection.Worksheet.Name = ws.Name Then
If TypeName(Selection) = "Range" Then
Dim rng As Range
Set rng = Intersect(Selection.Rows.EntireRow, _
ws.Columns(1).Resize(, 4))
If Not rng Is Nothing Then
rng.Select
End If
End If
End If
End Sub
Check this code:
Option Explicit
Sub Rows_Selection()
Dim rng As Range
Dim active_cells_adress, row_no As Variant
Dim final_selection_adress As String
Dim rng1 As String
Dim i As Integer
Selection.EntireRow.Select
Set rng = Selection
rng1 = rng.Address
final_selection_adress = ""
active_cells_adress = Split(rng1, "$")
For i = 2 To UBound(active_cells_adress)
row_no = Split(active_cells_adress(i), ",")
final_selection_adress = final_selection_adress + "A" & row_no(0) & ": D" & row_no(0) + ","
i = i + 1
Next
final_selection_adress = Left(final_selection_adress, Len(final_selection_adress) - 1)
Range(final_selection_adress).Select
End Sub
I am trying to write a macro that will look through all sheets in the workbook, and if a sheet name contains "blank", to rename that sheet with the value in cell C1.
Here is what I have so far:
Sub Rename()
Dim ws As Worksheet
Dim sheetBlank As Worksheet
Set sheetBlank = ActiveWorkbook.ActiveSheet
Dim nameCell As Range
Set nameCell = ActiveSheet.Range("C1")
For Each ws In Sheets
If sheetBlank.Name Like "*blank*" Then
sheetBlank.Name = nameCell.Value
End If
Next ws
End Sub
Now, this does rename the first active sheet, but it is not making any changes to the rest of them. What am I doing wrong?
You're referring to the wrong worksheet:
Sub Rename()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "*blank*" Then
ws.Name = ws.Range("C1").Value
End If
Next ws
End Sub
You set your objects outside the loop and never touch them again.
If you're going to use "ActiveSheet" you need to .Activate each sheet in order to work, but that's not a good approach since your iterator (ws) represents the sheet object.
Public Sub Rename()
Dim Ws As Worksheet
For Each Ws In Worksheets
If InStr(1, Ws.Name, "blank", vbTextCompare) > 0 Then _
Ws.Name = Ws.Range("C1").Value2
Next Ws
End Sub
I have an action log where users can select meeting name, user name, etc through a userform with comboboxes. I have also created a button where users can add a new meeting to the combo box list.
Currently I have a vba code that will check the value of a cell on sheet173 (data entered from userform), create a new sheet named with the cell value and copy the data from sheet173 into the new sheet. The problem I have is that if an action is added and there is already a sheet created for this, I need the data to be added to the next row of that sheet.
I have got the code working up until the point where the sheet is already created but additional rows need to be added. I know the exit sub needs to come out but i'm not sure what to replace it with.
Sub copy_newsheet()
Dim pname
Dim ws As Worksheet
pname = Sheets("Sheet173").Range("A1").Value
For Each ws In ActiveWorkbook.Sheets
If ws.Name = pname Then
Exit Sub
End If
Next ws
Sheets("Sheet173").Range("A1:E1").Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
ActiveSheet.Name = pname
End Sub
This should do it:
Option Explicit
Sub Test()
Dim pname As String
'full quallify your ranges, include the workbook
pname = ThisWorkbook.Sheets("Sheet173").Range("A1").Value 'thisworkbook means the workbook which contains the code
'with this variable we can know if the worksheet exists or not
Dim SheetExists As Boolean
SheetExists = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = pname Then SheetExists = True
Next ws
'check if it doesn't exist
If Not SheetExists Then
'if it doesn't exist, then create the worksheet and give it the name from pname
With ThisWorkbook
.Sheets.Add After:=.Sheets(.Sheets.Count)
.Sheets(.Sheets.Count).Name = pname
End With
End If
'with this variable we can find the last row
Dim LastRow As Long
With ThisWorkbook.Sheets(pname)
'calculate the last row on the pname sheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'equal the value from the pname sheet Range A:E to the sheet173 range A1:E1
.Range(.Cells(LastRow, "A"), .Cells(LastRow, "E")).Value = ThisWorkbook.Sheets("Sheet173").Range("A1:E1").Value
End With
End Sub
You are already pretty close, try this code:
Sub smth()
Dim pname As String
Dim ws As Worksheet, sh As Worksheet
pname = Sheets("Sheet173").Range("A1").Value
For Each sh In ActiveWorkbook.Sheets
If sh.Name = pname Then
Set ws = sh
GoTo Found
End If
Next sh
Set ws = Sheets.Add(After:=ActiveSheet)
ws.Name = pname
Found:
Sheets("Sheet173").Range("A1:E1").Copy
ws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End Sub
To explain: If the For loop finds a sheet with the specified namen it will set ws as that sheet and jump to Found:, where the actual copying and pasting happens. If the For loop doesn't find anything it will set ws as a new sheet.
Please note that ActiveWorkbook and ActiveSheet can be prone to causing unwanted errors.