How do i select worksheet using an inputbox in vba - vba

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

Related

VBA to rename sheets from active sheet sequentially

Its been a long time. I need a VBA to name my sheets Test 1, Test 2 etc from the active sheet and all to the right.
OR do the same for all selected sheets. IE, I'd select a block of 10 sheets and run my macro to rename them "Test 1,...Test 10"
it doesn't matter which method but there are sheets that I don't want the names changed so I either need the following to work ONLY on a block of selected sheets OR from an active sheet and all to the right.
I'm working from the following code:
Sub nameShts()
Dim i As Integer
For i = 1 To Worksheets.Count
Worksheets(i).Name = "Week" & i
Next i
End Sub
You were close for idea to loop from selected sheet to last sheet. Instead of 1 to Worksheets.Count use ActiveSheet.Index to Worksheets.Count
Sub nameShts()
Dim i As Integer
For i = ActiveSheet.Index To Worksheets.Count
Worksheets(i).Name = "Week" & i
Next i
End Sub
To loop the selected sheets, use ThisWorkbook.Windows(1).SelectedSheets to get a collection of the selected sheets.
Then simply loop the collection.
Select your desired sheets and run this:
Sub nameShts()
Dim i As Integer
i = 1
Dim sh As Worksheet
For Each sh In ThisWorkbook.Windows(1).SelectedSheets
sh.Name = "Week" & i
i = i + 1
Next sh
End Sub
It will only change the sheets selected
Worksheet.Next seems like a good fit for this problem
Sub nameShts()
Dim ws As Worksheet
Set ws = ActiveSheet
Do
ws.Name = "Test " & (ws.Index - ActiveSheet.Index + 1)
Set ws = ws.Next
Loop While Not ws Is Nothing
End Sub

Copying values from selected row to a specific cells in another worksheet - macro

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

Macro VBA: Match text cells across two workbooks and paste

I need help modifying a macro that matches the part number (Column C) between two sheets in different workbooks. Then it pastes the info from 'Original' sheet from the range P9:X6500 into the 'New' sheet into the range P9:X6500. The first sheet 'Original' in column C range C9:C6500 is the matching part number column. The 'New' sheet has the same column C with the part number to match. I only want match and paste the visible values.
I originally had this macro code which copy pastes only visible values from one workbook to another that I would like to modify it to match and copy paste:
Sub GetDataDemo()
Const FileName As String = "Original.xlsx"
Const SheetName As String = "Original"
FilePath = "C:\Users\me\Desktop\"
Dim wb As Workbook
Dim this As Worksheet
Dim i As Long, ii As Long
Application.ScreenUpdating = False
If IsEmpty(Dir(FilePath & FileName)) Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Else
Set this = ActiveSheet
Set wb = Workbooks.Open(FilePath & FileName)
With wb.Worksheets(SheetName).Range("P9:X500")
On Error Resume Next
.SpecialCells(xlCellTypeVisible).Copy this.Range("P9")
On Error GoTo 0
End With
End If
ThisWorkbook.Worksheets("NEW").Activate
End Sub
Also here is what I want it to look like:
Original
NEW
I appreciate the help!
try the following where it copies the range from one sheet to the other. You can break up With wb.Worksheets(SheetName).Range("P9:X500") into With wb.Worksheets(SheetName) then use .Range("P9:X500").Copy this.Range("P9") inside the With statement. Avoid using names like i or ii or this and use something more descriptive. The error handling is essentially only dealing with Sheets not being present and i think better handling of that scenario could be done. Finally, you need to turn ScreenUpdating back on to view changes.
Option Explicit
Public Sub GetDataDemo()
Const FILENAME As String = "Original.xlsx"
Const SHEETNAME As String = "Original"
Const FILEPATH As String = "C:\Users\me\Desktop\"
Dim wb As Workbook
Dim this As Worksheet 'Please reconsider this name
Application.ScreenUpdating = False
If IsEmpty(Dir(FILEPATH & FILENAME)) Then
MsgBox "The file " & FILENAME & " was not found", , "File Doesn't Exist"
Else
Set this = ActiveSheet
Set wb = Workbooks.Open(FILEPATH & FILENAME)
With wb.Worksheets(SHEETNAME)
'On Error Resume Next ''Not required here unless either of sheets do not exist
.Range("P9:X500").Copy this.Range("P9")
' On Error GoTo 0
End With
End If
ThisWorkbook.Worksheets("NEW").Activate
Application.ScreenUpdating = True ' so you can see the changes
End Sub
UPDATE: As OP wants to match between sheets on column C in both and paste associated row information across (Col P to Col X) second code version posted below
Version 2:
Option Explicit
Public Sub GetDataDemo()
Dim wb As Workbook
Dim lookupRange As Range
Dim matchRange As Range
Set wb = ThisWorkbook
Set lookupRange = wb.Worksheets("Original").Range("C9:C500")
Set matchRange = wb.Worksheets("ThisSheet").Range("C9:C500")
Dim lookupCell As Range
Dim matchCell As Range
With wb.Worksheets("Original")
For Each lookupCell In lookupRange
For Each matchCell In matchRange
If Not IsEmpty(matchCell) And matchCell = lookupCell Then 'assumes no gaps in lookup range
matchCell.Offset(0, 13).Resize(1, 9).Value2 = lookupCell.Offset(0, 13).Resize(1, 9).Value2
End If
Next matchCell
Next lookupCell
End With
ThisWorkbook.Worksheets("NEW").Activate
Application.ScreenUpdating = True
End Sub
You may need to amend a few lines to suit your environment e.g. change this to meet your sheet name (pasting to).
Set matchRange = wb.Worksheets("ThisSheet").Range("C9:C500")

How to copy range of cells using inputbox and paste to newly created sheet

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

How to name Excel worksheets alphabetically?

I am trying to create a macro that will copy actual sheet and name it with next letter of the alphabet. First sheet "A" always exists in the workbook, other sheets (B, C, D, etc.) will be added as necessary. I managed to put together the following piece of code that can create sheet "B". Issue is that when copying sheet "B", I get Run-time error '1004' indicating error on the last line of code.
Sub newList()
' New_List Macro
Dim PrevLetter As String
PrevLetter = "ActiveSheet.Name"
ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = Chr(Asc(PrevLetter) + 1)
End Sub
Can anyone of you help?
Your code is giving an error as Soren mentioned.
However your code will give an error if sheet "A" is active after creation of "B" as sheet "B" already exists.
You might want to try this? for this, it's not important which sheet is active. Also this code will let you create sheets beyond Z. So sheets after Z will be named as AA, AB etc..
Using this code, In XL2007+ you can create sheets up till XFD (more 16383 sheets)
Using this code, In XL2003 you can create sheets up till IV (more 255 sheets)
CODE:
Sub newList()
Dim PrevLetter As String
Dim ws As Worksheet, wsNew As Worksheet
Dim wsname As String
Set ws = ThisWorkbook.Sheets("A")
ws.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set wsNew = ActiveSheet
wsname = GetNewName
wsNew.Name = wsname
End Sub
Function GetNewName() As String
Dim NewWs As Worksheet
For i = 2 To ThisWorkbook.Sheets(1).Columns.Count
ColName = Split(ThisWorkbook.Sheets(1).Cells(, i).Address, "$")(1)
On Error Resume Next
Set NewWs = ThisWorkbook.Sheets(ColName)
If Err.Number <> 0 Then
GetNewName = ColName
Exit For
End If
Next i
End Function
You should simply write your code like this instead:
Sub newList()
' New_List Macro
Dim PrevLetter As String
PrevLetter = ActiveSheet.Name '<--- Change made to this line
ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = Chr(Asc(PrevLetter) + 1)
End Sub
EDIT: This is not a "best practice code" answer. This just points out what in your own code were returning the error. The other answers to this question (so far) are indeed much more sophisticated and correct ways of solving this problem.
Here is another way you could do this:
Sub newList()
' New_List Macro
Dim PrevLetter As String
Dim wb As Workbook
Dim ws1 As Worksheet
Set wb = ActiveWorkbook
Set ws1 = wb.ActiveSheet
PrevLetter = ws1.Name
ws1.Copy After:=ws1
Sheets(Sheets.Count).Name = Chr(Asc(PrevLetter) + 1)
Set wb = Nothing
Set ws1 = Nothing
End Sub