VBA rename sheet based on cell value - vba

I want a VBA code that rename my sheetXXX, where XXX is the value in the cell B5 in “Sheet1” sheet. The macro should work for any value in B5.
I tried the following code:
Sub tabname()
Dim sheetXXX As Worksheet
XXX.Name = Worksheets("Sheet1").Range("B5").Value
End Sub

You have to set the object = to the actual worksheet to be renamed.
Sub tabname()
Dim sheetXXX As Worksheet
Set sheetXXX = ActiveWorkbook.Sheets("sheetXXX")
sheetXXX.Name = "Sheet" & Worksheets("Sheet1").Range("B5").Value
End Sub
If sheetXXX is meant to be the active worksheet you would do this.
Sub tabname()
Dim sheetXXX As Worksheet
Set sheetXXX = ActiveWorkbook.Activesheet
sheetXXX.Name = "Sheet" & Worksheets("Sheet1").Range("B5").Value
End Sub

Related

Can't define workheet in VBA

Going crazy here. I use this definition of worksheet all the time. Copied every string to avoid typing errors. Still, the code below produces "Nothing" when I try to set FR worksheet. Pls help!
Sub FindReplace()
Dim FRep As Worksheet
Dim c As Range
Dim cText As TextBox
Dim i As Integer
Set FRep = ThisWorkbook.Worksheets("FindReplace")
For i = 1 To 23
cText = FRep.Cells(i, 3).Text
FRep.Cells(i, 2).NumberFormat = "#"
FRep.Cells(i, 2).Value = cText
Next i
The code as is seems correct. Make sure that "FindReplace" worksheet is in ThisWorkbook.
Also, you can try to get "FindReplace" worksheet by CodeName instead of by the name of the sheet. The advantage is that if the user changes the name of the worksheet, the CodeName will remain the same and you won't need to update your code to the new worksheet name.
Public Function GetWsFromCodeName(codeName As String, wb As Workbook) As Worksheet
Dim ws As Worksheet
For Each ws In wb.Worksheets
If ws.CodeName = codeName Then
Set GetWsFromCodeName = ws
Exit For
End If
Next ws
End Function
Add this function in your code:
Sub FindReplace()
Dim FRep As Worksheet
Set FRep = GetWsFromCodeName("YourCodeName", ThisWorkbook)

Excel VBA: Counting Data in Column from Another Workbook and Inputting Counter in Master Workbook

I need to create a macro in my CountResults.xlsm (Master Workbook) that solves the following problem. I have a column of data in another worksheet with either YES or NO. I need to come up with a macro that counts the amount of "YES" in the column. The column is located in Sheet2 of the workbook Test01.xlsx. Then take that count and put it in one cell in my CountResults.xlsm file. Like so:
I have a code that displays a count for a column in the same sheet. But this code does not count when there are 'breaks' in the column (empty spaces) like I have in my picture. This is that code:
Private Sub CommandButton1_Click()
MsgBox Range("A1").End(xlDown).Row
Range("A1").End(xlDown).Offset(1, 0).Select
End Sub
I have another code that helps with accessing another workbook and defining values for each workbook and worksheet:
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim shSource As Worksheet
Dim shTarget As Worksheet
Set wbSource = Workbooks.Open(Filename:="C:\Users\khanr1\Desktop\Test_Excel\Test03.xlsm", ReadOnly:=True)
Set wbTarget = ThisWorkbook
Set shSource = wbSource.Worksheets("Sheet2")
Set shTarget = wbTarget.Worksheets("Sheet1")
Use COUNTIF. It will give you the total even if the range is in another workbook. i.e. =COUNTIF([Book2.xlsx]Sheet2!$D$2:$D$9, "Yes"). Problem with having COUNTIF within your sheet as a formula is that you will need to open the other workbook if you want the count to be update. Below VBA code will perform an update for you. Assign the sub to a button in your CountResults.xlsm workbook
EDIT: Added row count as per OP's requirement
Sub UpdateResults()
Dim oWBWithColumn As Workbook: Set oWBWithColumn = Application.Workbooks.Open("<your Test01.xlsx address here>")
Dim oWS As Worksheet: Set oWS = oWBWithColumn.Worksheets("Sheet2")
Dim intLastRow as Integer: intLastRow = oWS.Cells(Rows.Count, "B").End(xlUp).Row
ThisWorkbook.Worksheets("<name of the sheet in your CountResults.xlsm workbook>").Range("<cell address>").Value = Application.WorksheetFunction.CountIf(oWS.Range("B2:B" & intLastRow), "yes")
oWBWithColumn.Close False
Set oWS = Nothing
Set oWBWithColumn = Nothing
End Sub

Copy sheet without creating new instances of named ranges?

I'm using the following code to copy a sheet. I also have a few named ranges that are scoped to the Workbook. The problem is, when I do the copy, it creates duplicates of all the named ranges with a scope of the new sheet. Everything works of course but I could potentially have 20+ sheets. I don't need 80 named ranges that are mostly duplicates. How can I avoid this?
Sub btnCopyTemplate()
Dim template As Worksheet
Dim newSheet As Worksheet
Set template = ActiveWorkbook.Sheets("Template")
template.Copy After:=Sheets(Sheets.Count)
Set newSheet = ActiveSheet
newSheet.Name = "NewCopy"
End Sub
And the Name Manager after a copy:
Here is my answer:
Sub btnCopyTemplate()
Dim template As Worksheet
Dim newSheet As Worksheet
Set template = ActiveWorkbook.Sheets("Template")
template.Copy After:=Sheets(Sheets.Count)
Set newSheet = ActiveSheet
newSheet.Name = "NewCopy"
deleteNames 'Check the sub
End Sub
Sub deleteNames()
Dim theName As Name
For Each theName In Names
If TypeOf theName.Parent Is Worksheet Then
theName.Delete
End If
Next
End Sub
This way you will delete all the names with the scope "worksheet" and keep the "workbook" names
Edit#2
After read the comments here is the update passing the sheet to loop only the "newSheet"
Sub btnCopyTemplate()
Dim template As Worksheet
Dim newSheet As Worksheet
Set template = ActiveWorkbook.Sheets("Template")
template.Copy After:=Sheets(Sheets.Count)
Set newSheet = ActiveSheet
newSheet.Name = "NewCopy"
deleteNames newSheet
End Sub
Sub deleteNames(sht As Worksheet)
Dim theName As Name
For Each theName In Names
If (TypeOf theName.Parent Is Worksheet) And (sht.Name = theName.Parent.Name) Then
theName.Delete
End If
Next
End Sub

VBA: VLookup between two workbooks

I am wondering if someone can help me out. I created a Userform with 3 comboboxes. Combobox 1 and 2 list all open workbooks. Combobox 3 lists the worksheets from Combobox 2. I now want to run a Vlookup. The lookup values are the values (in this case product codes) in each cell beginning at D9 to the last cell with a value in Column D of the first Worksheet of Combobox2's. The lookup range will be ("A5:S###"[number of rows varies depending on the file]").
The Vlookup formula should be in the Column I of the first Worksheet of Combobox2's value starting at "I9" looping through each cell in I9 until all the Codes in D9 are looked up.
I keep getting error the major one being “Runtime-error '9'”: Subscript out of range. Here is my code.
Option Explicit
Private Sub CancelButton_Click()
Stopped = True
Unload Me
End Sub
Private Sub ComboBox1_Change()
Dim ScheduleA As Workbook
Dim Termset As Worksheet
Set ScheduleA = Workbooks(Me.ComboBox1.Value)
With Me.ComboBox3
For Each Termset In ScheduleA.Worksheets
.AddItem Termset.Name
Next Termset
End With
End Sub
Private Sub FillACDButton_Click()
Dim ACDRebateInfo As Worksheet
Dim lastRow As Long
Dim NewRebate As Single
Dim NewRebateType As String
Dim LookUp_Range As Range
Dim ActionCode As String
Dim ACD_NewRebate As Range
Dim ACD_NewRebateType As Range
Dim ACD_ActionCode As Range
Dim SCC As Range
Dim Cell As Range
Set ACDRebateInfo = Workbooks(Me.ComboBox2.Value).Worksheets(1)
Set ACD_NewRebate = ACDRebateInfo.Range("I9:I500")
Set ACD_NewRebateType = ACDRebateInfo.Range("J9:J500")
Set ACD_ActionCode = ACDRebateInfo.Range("B9:B500")
Set LookUp_Range = Worksheets(Me.ComboBox3.Value).Range("A5:S400")
Set SCC = ACDRebateInfo.Range("D9:D230")
With ACDRebateInfo
For Each Cell In ACD_ActionCode
ActionCode = Application.WorksheetFunction.VLookup(SCC, LookUp_Range, 17, False)
Next Cell
End With
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim wkb As Workbook
For Each wkb In Application.Workbooks
Me.ComboBox1.AddItem wkb.Name
Me.ComboBox2.AddItem wkb.Name
Next wkb
End Sub
Not sure this is your issue but this piece of code does not make sense:
For Each Cell In ACD_ActionCode
ActionCode = Application.WorksheetFunction.VLookup(SCC, LookUp_Range, 17, False)
Next Cell
You are looping through the Action Codes but not using the Cell variable

How do i select worksheet using an inputbox in 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