It's my 1st time here and needed some help. not good with coding as I just started with the help of youtube. I saw a post here that helps you create sheets with VBA. and this is what i started on. MAybe you can help me along the way.
Sub cutcell()
Dim number, name As Variant
'ask the number of cell and name of new sheet
number = InputBox("Number of cells to cut")
name = InputBox("Name of new sheet")
' select Cell from A1 to the number of sheet inputted
Range("A1:A(number)").Select
Selection Cut
'creates a new worksheet
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).name = name.Value ' renames the new worksheet
Range("A1").Select
activeheet.Paste
End Sub
Try it like this...
Sub cutcell()
Dim wsNew As Worksheet
Dim RngToCut As Range
Dim number, NewName As Variant
Application.ScreenUpdating = False
'ask the number of cell and name of new sheet
number = Application.InputBox("Number of cells to cut", Type:=1) 'This will only allow a number input
If number = 0 Then
MsgBox "You didn't enter number.", vbCritical
Exit Sub
End If
Set RngToCut = Range("A1:A" & number)
'Ask user to input name of the New Sheet
NewName = InputBox("Name of new sheet")
If NewName = "" Then
MsgBox "You didn't input the name of New Sheet.", vbCritical, "New Sheet Name Missing!"
Exit Sub
End If
Set wsNew = Sheets.Add(After:=Sheets(Sheets.Count))
wsNew.name = NewName
RngToCut.Cut wsNew.Range("A1")
Application.ScreenUpdating = True
End Sub
One problem is here:
Range("A1:A(number)").Select
You need to work out the range but putting it in quotes takes it as literally what you say. Try this:
Range("A1:A" + number).Select
Another problem is here:
activeheet.Paste
You have misspelled ActiveSheet. Try:
ActiveSheet.Paste
It's better if you stay away from Select, Selection and ActiveSheet, and instead use fully qualified Range and Worksheets objects.
Read here How to avoid using Select in Excel VBA .
Also, the Cut>>Paste is a 1-line syntax (see code below), just try to keep the 2 actions as close as can be (create the new Worksheet object before this action).
Code
Option Explicit
Sub cutcell()
Dim number As Long, name As String
Dim OrigSht As Worksheet
Dim NewSht As Worksheet
'ask the number of cell and name of new sheet
number = InputBox("Number of cells to cut")
name = InputBox("Name of new sheet")
' save the currebt active sheet
Set OrigSht = ActiveSheet ' <-- I still prefer to use Worksheets("SheetName")
' first create the new worksheet
Set NewSht = Sheets.Add(After:=Sheets(Sheets.Count))
NewSht.name = name ' renames the new worksheet
' select Cell from A1 to the number of sheet inputted , use Cut>>Paste in 1 line
OrigSht.Range("A1:A" & number).Cut Destination:=NewSht.Range("A1")
End Sub
A inputbox type 8 could be used for that purpose, since it lets user pick the desired range.
You might find other examples in here.
Cris
Related
I have a list of items and a new sheet button like this:
For each item you have to be able to create new worksheet when you click on that button. It copies a worksheet from a template, one worksheet for a single row. Now i want to be able to copy some of the info from a row i select to that new worksheet cells when i click on the button and maybe rename the worksheet as a value in one of the cells (ID). The values i need are ID and name, maybe few more.
Sub AddNameNewSheet2()
Dim CurrentSheetName As String
CurrentSheetName = ActiveSheet.Name
'Add New Sheet
Dim i As Byte, sh As Worksheet
For i = 1 To 1
Sheets("Predlozak").Copy After:=Sheets("Predlozak")
Set sh = ActiveSheet
Next i
On Error Resume Next
'Get the new name
ActiveSheet.Name = InputBox("Name for new worksheet?")
'Keep asking for name if name is invalid - Here i want to change worksheet name to a specific cell value from selected row.
Do Until Err.Number = 0
Err.Clear
ActiveSheet.Name = InputBox("Try Again!" _
& vbCrLf & "Invalid Name or Name Already Exists" _
& vbCrLf & "Please name the New Sheet")
Loop
On Error GoTo 0
End Sub
Anyone has an idea how can i make this work?
Here's what I came up with, I also thought checkboxes would be a good way to pick the line, it's quite simple:
Sub AddNameNewSheet2()
Dim x As Long
Dim wks As Worksheet
Dim IdCell As Range, NamCell As Range, FormCell As Range
Set wks = ActiveSheet
Set IdCell = wks.Range("A:A").Find("TRUE").Offset(0, 1)
Set FormCell = IdCell.End(xlToRight)
Set NamCell = IdCell.Offset(0, 1)
Sheets.Add After:=Sheets(1), Type:= _
"C:\Users\*yournamehere*\AppData\Roaming\Microsoft\Templates\*yourtemplatehere*.xltm"
ActiveSheet.Name = NamCell
Dim wks2T As ListObject
Set wks2T = ActiveSheet.ListObjects(1)
With wks2T
.ListColumns(1).Range(2) = IdCell.Value
.ListColumns(2).Range(2).Value = NamCell.Value
.ListColumns(3).Range(2).Value = FormCell.Value
End With
End Sub
I made the template a table cause it is easier to specify exactly where to put stuff. And it is more manageable as more data is added in the future.
Sheet1 image
Sheet2 image
I am trying to work on a Worksheet whose name is a variable.
I have a main sheet, called "data" where I go to catch a list of names of existing sheets.
My code is as follows :
Dim data as Worksheet
dim sheet_name as String
Dim i as Integer
Set data = ThisWorkbook.Sheets("Data")
For i = 2 to 10
sheet_name = data.Range("A"&i).Value
With ThisWorkbook.Sheets(sheet_name)
'Operations on the worksheet
End With
Next i
The error prompted is "Runtime Error 9 : Subscript Out of Range" for the specific line :
With This Workbook.Sheets(sheet_name)
It is as if the object Sheets didn't understand the string sheet_name.
The Sheet "sheet_name" exists for sure, I double-checked.
Unfortunately, I cannot call the sheet by its name because I have too many sheets to operate on, this is why I wanted to do a loop.
I tried not working with the "With" clause but just referring to every object of the sheets with "ThisWorkbook.Sheets(sheet_name) in front but doesn't work either.
Do you know if it is possible to call a string variable inside a Sheets()?
Thanks a lot for your help !
Kind regards,
The reason for your error was given in the comments above by #chris neilsen
You could use the code below to check or avoid having these kind of errors:
Option Explicit
Sub CheckShtExists()
Dim data As Worksheet
Dim sheet_name As String
Set data = ThisWorkbook.Sheets("Data")
Dim ws As Worksheet
Dim ShtNamesArr() As String
Dim i As Long
ReDim ShtNamesArr(0 To ThisWorkbook.Worksheets.Count - 1) ' resize array to number of worksheets in This Workbook
' loop thourgh all worksheets and store their names in array
For Each ws In ThisWorkbook.Worksheets
ShtNamesArr(i) = ws.Name
i = i + 1
Next ws
For i = 2 To 10
If data.Range("A" & i).Value <> "" Then ' ignore blank cells
sheet_name = data.Range("A" & i).Value
If Not IsError(Application.Match(sheet_name, ShtNamesArr, 0)) Then ' use Application.Match to see there is a sheet with this name
With ThisWorkbook.Sheets(sheet_name)
'Operations on the worksheet
End With
Else ' No Match
MsgBox sheet_name & " doesn't exists in your workbook"
End If
End If
Next i
End Sub
I am using Excel and am looking to get the name of the table based on a cell address (ex A3), this cell will not move. How would I go about stating this in Excel's VBA?
My plan is to have code that will copy data validations from a row of one table on my Maintenance tab to a single table on each tab of my workbook (minus my "TOC" and "data" tabs). Each tab is a copy of a "TEMPLATE" worksheet (minus the "TOC", "data", & the "TEMPLATE (Maint.)" worksheets). Worksheets "data", "TEMPLATE", and "TEMPLATE (Maint.)" may or may not be hidden.
The code I have in my "Copy_Data_Validations" sub is as follows:
Dim TotalSheets As Integer
Dim p As Integer
Dim iAnswer As VbMsgBoxResult
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
'
' Move sheet "TOC" to the begining of the workbook.
'
Sheets("TOC").Move Before:=Sheets(1)
'
' Move sheet "data" to be the second sheet in the workbook.
'
Sheets("data").Move Before:=Sheets(2)
iAnswer = MsgBox("You are about to copy data validations!", vbOKCancel + vbExclamation _
+ vbDefaultButton2 + vbMsgBoxSetForeground, "Copying Data Valadations")
For TotalSheets = 1 To Sheets.Count
For p = 3 To Sheets.Count - 2
'
' If the answer is Yes, then copy data validations from "TEMPLATE (Maint.) to all other.
' sheets minus the "TOC" sheet and the "data" sheet.
'
If iAnswer = vbYes Then
If UCase$(Sheets(p).Name) <> "TOC" And UCase$(Sheets(p).Name) <> "data" Then
' This chunk of code should copy only the data validations
' of "Table1_1" (A4:AO4) from the maintenance tab to all
' rows of a single table on each worksheet (minus the
' "TOC", "data", & the "TEMPLATE (Maint.)" worksheets.
' This is the section of code I am looking for unless
' someone has something better they can come up with.
Selection.PasteSpecial Paste:=xlPasteValidation, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
'
' If the answer is Cancel, then cancels.
'
ElseIf iAnswer = vbCancel Then
' Add an exit here.
End If
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
Attempting to get the name of a ListObject for any cell will cause an error if that cell is not a part of a table.
Option Explicit
Function CellInTable(thisCell As Range) As String
Dim tableName As String
tableName = ""
On Error Resume Next
tableName = thisCell.ListObject.Name
CellInTable = tableName
End Function
The original question was a bit ambiguous, thus the answer was extended to address all related use-cases.
One possible alternative is to use the Worksheet Formula shown below entered in any Worksheet Cell (for e.g. $A$3) and then refer it from Excel VBA macro:
Listing 1. Get Excel Worksheet Name using Cell Formula
=MID(CELL("filename",A3),FIND("]",CELL("filename",A3))+1,255)
The Formula essentially extracts the Worksheet Name from the Workbook full path.
Alternatively, you can achieve this in VBA provided that you pass the Range object referring that cell in Worksheet, like in the following demo sample:
Listing 2. Test Sub to get Excel Worksheet and Table Names for Cell "A3"
Option Explicit
'Cell "A3" under the test
Sub GetWorksheetAndTableName()
Dim myCell As Range
Set myCell = Range("$A$3")
Debug.Print "Worksheet Name: " & GetWorksheetName(myCell)
Debug.Print "Table Name: " & GetTableName(myCell)
End Sub
Listing 3. Function to get a Worksheet Name for a Cell
'get Worksheet Name from Range object
Function GetWorksheetName(CellRange As Range) As String
On Error Resume Next
GetWorksheetName = Split(Split(CellRange.Address(External:=True), "]")(1), "!")(0)
End Function
And, in it's simplest form, the Worksheet Name could be obtained using the following statement (replacing that one in the Function shown in Listing 3):
Listing 4. Alternative method to get Parent Worksheet Name for Cell/Range object
GetWorksheetName = CellRange.Parent.Name
In order to get the Table Name for the specified Worksheet Cell refer to the code snippet shown in the following Listing 5:
Listing 5. Get Table Name for Worksheet Cell
Function GetTableName(CellRange As Range) As String
If (CellRange.ListObject Is Nothing) Then
GetTableName = ""
Else
GetTableName = CellRange.ListObject.Name
End If
End Function
Hope this may help.
I have a couple macros that pull in two sheets to a single workbook from different workbooks in a file and compare the two sheets row by row for differences. The problem is that whenever I'm comparing new pairs of sheets I have to change all the sheet references in the VBA code. Is there a way to add an input or message box asking for the two new names of the sheets? For example one box would pop up and say, "Please enter the original sheet name" and another that would pop up and say, "Please enter the new sheet name." Additionally, is there a way to combine theses macros to as few as possible?
Sub GetSourceSheets()
'This macro will loop through excel files
'in a location and copy the their worksheets into the current workbook.
'Instructions: Replace the file path, which starts on the 8th line, with a file path to the folder
'that contains the two vendor site lists that you wish to compare.
'!!!! Do not for get to place the back slash (\) at the end of the file path. !!!! End of Instructions
Application.DisplayAlerts = False
Path = "C:\Users\turner\Desktop\Excel_Con\Kevin\NA_Vendor\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.DisplayAlerts = True
End Sub
Sub RunCompare()
'Instructions: Replace North_American_Old with the original vendor site list sheet name and
'replace North_American_New with the new vendor site list sheet name you wish
'to compare to the original vendor site list sheet.
'!!!!! Keep sheet names enclosed in quotations !!!! End of Instructions
Call compareSheets("North_America_Old", "North_America_New")
End Sub
Sub compareSheets(shtNorth_America_Old As String, shtNorth_America_New As String)
'Instructions: Replace North_American_Old with the original vendor site list sheet name and
'replace North_American_New with the new vendor site list sheet name you wish
'to compare to the original vendor site list sheet.
'!!!!! Keep sheet names enclosed in quotations and remember to keep "sht" at the beginning of the sheet name!!!!
'End of Instructions
Dim mycell As Range
Dim mydiffs As Integer
'For each cell in sheet2 that is not the same in Sheet1, color it yellow
For Each mycell In ActiveWorkbook.Worksheets(shtNorth_America_New).UsedRange
If Not mycell.Value = ActiveWorkbook.Worksheets(shtNorth_America_Old).Cells(mycell.Row, mycell.Column).Value Then
mycell.Interior.Color = vbRed
mydiffs = mydiffs + 1
End If
Next
'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(shtNorth_America_New).Select
End Sub
Compare Macros with Input Boxes
Sub RunCompare()
Dim sht1 As String
Dim sht2 As String
sht1 = Application.InputBox("Enter the first sheet name")
sht2 = Application.InputBox("Enter the second sheet name")
Call compareSheets("sht1", "sht2")
End Sub
Sub compareSheets(sht1 As String, sht2 As String)
Dim mycell As Range
Dim mydiffs As Integer
'For each cell in sheet2 that is not the same in Sheet1, color it yellow
For Each mycell In ActiveWorkbook.Worksheets(sht2).UsedRange
If Not mycell.Value = ActiveWorkbook.Worksheets(sht1).Cells(mycell.Row, mycell.Column).Value Then
mycell.Interior.Color = vbRed
mydiffs = mydiffs + 1
End If
Next
'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(sht2).Select
End Sub
Use an inputbox:
Dim sht1 as String
Dim sht2 as String
sht1 = Application.InputBox("Enter the first sheet name")
sht2 = Application.InputBox("Enter the second sheet name")
But with this approach, you need to trap errors: if the user has misseplled the worksheet name, etc., or if they cancel out of the input box, etc.
Alternatively, a UserForm with ListBox or ComboBox to choose worksheets. Again, you'll need to do some validation (user can't select the same sheet in both lists, etc.) but I will leave the actual use-case for you to work out.
Create a user form with two comboboxes and a command button.
Sub UserForm_Activate()
Dim ws as Worksheet
For each ws in ThisWorkbook.Worksheets
Me.ComboBox1.AddItem ws.Name
Me.ComboBox2.AddItem ws.Name
Next
End Sub
Sub CommandButton1_Click()
Call compareSheets(ComboBox1.Value, ComboBox2.Value)
End Sub
Alternatively, just select the two worksheets you want to compare, and do something like this:
Sub RunCompare()
Dim selSheets as Sheets
Set selSheets = ActiveWindow.SelectedSheets
If selSheets.Count = 2 Then
Call CompareSheets(selSheets(1).Name, selSheets(2).Name)
Else:
MsgBox "Please select TWO sheets to compare", vbInformation
End If
End Sub
I am trying to select a worksheet every time when i open up a workbook using an inputbox in VBA. here is my code for opening a workbook but after i open up my workbook, how do i select a worksheet inside that workbook?
Sub button7_click()
dim wb as string
dim ss as string
wb = Application.GetOpenFilename
if wb <> "False" Then Workbooks.Open wb
End sub
Assuming "Sheet1" is the name of the sheet that you want to select...
Workbooks(wb).Sheets("Sheet1").Select
EDIT: And you can use something like this to get a variable sheet name from an InputBox. In its simplest form...
Dim Result As String
Result = InputBox("Provide a sheet name.")
Workbooks(wb).Sheets(Result).Select
...but I would add some error handling into this also to prevent errors from blanks, misspelled or invalid sheet names.
Let's say you have a "normal", blank Excel workbook with sheets "Sheet1", "Sheet2" and "Sheet3". Now, when the workbook opens, let's assume you want to activate (not select, as that's different) the sheet called "Sheet2".
In your workbook's ThisWorkbook module, add this code:
Private Sub Workbook_Open()
ActiveWorkbook.Sheets("Sheet2").Activate
End Sub
Make sure this code is pasted inside of the ThisWorkbook object and not in a Module, Form, or Sheet object.
Save and exit the workbook. When you re-open it, "Sheet2" will be the active sheet.
Here is the final code if anyone wants it.
Multiple selections are not quite possible , as the copied worksheet only copies across and increments the largest value of the range selected rather than all the cells selected individually ....
Sub CopyAndIncrement()
Dim ws As Worksheet
Dim Count As Integer
Dim Rng As Range
Dim myValue As Integer
Dim wsName As String
wsName = InputBox("Provide the EXACT sheet name you want to copy.")
'error handling loop for Worksheet name
For p = 1 To Worksheets.Count
If Worksheets(p).Name = wsName Then
exists = True
End If
Next p
If Not exists Then
While exists = False
wsName = InputBox("Sheet not found re-enter name.")
For p = 1 To Worksheets.Count
If Worksheets(p).Name = wsName Then
exists = True
End If
Next p
Wend
End If
Set Rng = Application.InputBox( _
Title:="Increment your worksheet", _
Prompt:="Select a cell(s) you want to increment", _
Type:=8)
On Error GoTo 0
If Rng Is Nothing Then Exit Sub 'Test to ensure User Did not cancel
'Set Rng = Rng.Cells(1, 1) 'Set Variable to first cell in user's input (ensuring only
'1 cell) >> commenting this can give multiple selections
myValue = InputBox("How many time do you want it to increment? Give me the number ")
Do While Count < myValue
For Each ws In Worksheets ' this loop selects the last sheet in the workbook
LastWs = ws.Name
i = ws.Range(Rng.Address).Value
If i > j Then
j = i
End If
Next
Sheets(wsName).Select
Sheets(wsName).Copy After:=Sheets(LastWs)
ActiveSheet.Range(Rng.Address).Value = j + 1
Count = Count + 1
Loop
End Sub