I am working on a dashboard/stats for employees at my company, and I've run into a bit of a hiccup with one of my codes. Here's a bit of background to start
Each employee has 2 sheets with their different stats.
The first sheet is always visible and has a macro that will un-hide and activate the 2nd sheet (so that the workbook doesn't get too unmanageable.) When you click off the 2nd sheet, I have a macro that will hide it (it uses workbook_Sheetdeactivate to close the sheet if it has properties related to the 2nd sheet)
The first sheet's tab-name is added to a cell (in my case range("A62")), with the formula "=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255)".
I then make that cell equal to range("A1") on the second sheet. What I want is for the the name of the 2nd sheet to equal range("A1") & " Achievements", so that the 2nd sheet can be referenced in my macros by the first sheet. (Ex: if sheet1 is "Bobby", sheet2 is "Bobby Achievements")
I didn't have trouble writing the macro itself, but I don't know which sub would be best to use so that the macro is activated at the right time. Is there a way to have the macro run whenever a sheetname is changed in the workbook?
Here's the code:
dim ws as worksheet
'Sorting through each sheet to find "Achievement Sheets"
For Each ws in Workbook
If ws.range("W1").Value = "Achievement Lists" Then
ws.name = ws.Range("A1") & " Achievements"
End if
Next ws
It may be a bit crude, but you could simply use the 'Calculate' event on the second worksheet object to update its own name.
Private Sub Worksheet_Calculate()
If Range("A1") & " Achievements" <> Me.Name Then
Me.Name = Range("A1") & " Achievements"
End If
End Sub
or use the 'SheetCalculate event in the workbook object:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
On Error Resume Next
If Sh.Range("W1").Value = "Achievement Lists" Then
If Sh.Range("A1").Value & " Achievements" <> Sh.Name Then
Sh.Name = Sh.Range("A1") & " Achievements"
End If
End If
End Sub
Related
I'm making a budgeter sort of thing that helps people keep track of their money. I currently have a bunch of code that checks the current month and attempts to make a new sheet with the name (MM/YYYY) unless that sheet has already been made, if it has been made then nothing will happen.
Private Sub Worksheet_Change(ByVal Target As Range)
nowMonth = Month(Now)
nowYear = Year(Now)
sheetNameStr = nowMonth & "," & nowYear
sheetExists = False
For Each Sheet In Worksheets
If sheetNameStr = Sheet.Name Then
sheetExists = True
End If
Next Sheet
If sheetExists = False Then
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = sheetNameStr
MsgBox ("New sheet named " & sheetNameStr & "was created")
End If
Sheets("Main").Activate
Worksheets("Main").Range("A5:D300").Copy Worksheets("sheetNameStr").Range("A1")
End Sub
The problem I am having is trying to copy and paste the history of my purchases/income and pasting it into the new sheet. I always get the
Run-time error '9': Subscript out of range
error.
If anyone could help that'd be great thanks!
Your line saying
Worksheets("Main").Range("A5:D300").Copy Worksheets("sheetNameStr").Range("A1")
is referring to a worksheet called "sheetNameStr", but you really want to refer to a sheet with the name contained in the variable sheetNameStr, i.e.
Worksheets("Main").Range("A5:D300").Copy Worksheets(sheetNameStr).Range("A1")
My problem is that I need to execute a Macro only on the marked cell.
The Macro needs to do the following:
Selected cell is formated always for example as 20*20*20 always 3 numbers.
It should copy this text add a " = " before the numbers and output it on another column.
The Code I got until now is:
Sub First()
'
' First Makro
'
'
Selection.Copy
Range("G11").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=20*20*20"
Range("G12").Select
End Sub
I have got this code with the record Macro function
Thanks very much
#SiddharthRout exactly but i need to be able to select it by hand because sometimes it's for example E17 sometimes e33 and output always need's to be G Column in the Same Row
Is this what you are trying?
Sub Sample()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
'~~> Replace Sheet1 with the relevant sheet name
Set ws = wb.Sheets("Sheet1")
'~~> Check if what the user selected is a valid range
If TypeName(Selection) <> "Range" Then
MsgBox "Select a range first."
Exit Sub
End If
'~~> Check if the user has selected a single cell
If Selection.Cells.Count > 1 Then
MsgBox "Please select a single cell"
Exit Sub
End If
ws.Range("G" & Selection.Row).Formula = "=" & Selection.Value
End Sub
I want to move sheets to a new workbook and save it as a new workbook with the sheet name. I have got that part, but I want to repeat it until all the sheets are moved from the main workbook.
the code I used is below:
Sub MoveToNew()
'Move the active sheet to a new Workbook.
Activesheet.Move
MName = Activesheet.Name & ".xls"
MDir = ActiveWorkbook.Path
ActiveWorkbook.SaveAs Filename:="C:\Users\DICS-IN\Desktop\Check\" & MName
ActiveWorkbook.Save
ActiveWorkbook.Close
It works until this but I want the same thing to be repeated until all the sheets are moved and saved separately from the main sheet.
I found Dim as Integer and etc but couldn't do it.
loop through all sheets using a For Each ... Next loop
Example:
Sub test()
Dim S As Worksheet
' loop through all worksheets
For Each S In ActiveWorkbook.Worksheets
Debug.Print S.Name
' do something with S
Next S
End Sub
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
Sub RunMacroOnAllSheetsToRight()
For i = ActiveSheet.Index To Sheets.Count
Call MyFunction(i)
Next i
End Sub
Function MyFunction(i)
'Code goes here
Columns("R:R").ColumnWidth = 8.1
[S1].Resize(, 14).EntireColumn.Insert
MsgBox "I'm currently on sheet " & ThisWorkbook.Sheets(i).name
End Function
I found a sample of code for running macro that should run on all sheets on the right from the active one, but it is not working, it keeps running on one sheets, but the msgbox shows me that the sheets are changed(each time it displays different name). Can you help me? I am new to vba-excel.
You need to activate each sheet. Then activate original sheet.
Sub RunMacroOnAllSheetsToRight()
Dim a As Integer
a = ActiveSheet.Index 'Save current sheet
For i = a To Sheets.Count
Call MyFunction(i)
Next i
Sheets(a).Activate 'At the end, activate original sheet
End Sub
Function MyFunction(i)
'Code goes here
Sheets(i).Activate 'Activate each sheet
Columns("R:R").ColumnWidth = 8.1
[S1].Resize(, 14).EntireColumn.Insert
MsgBox "I'm currently on sheet " & ActiveSheet.Name 'Trustworthy information
End Function