I have a workbook with 12 worksheets each named JANUARY through FEBRUARY.
Only the current month's sheet (e.g., NOVEMBER) will ever contain a cell containing the function =TODAY() in mm/dd/yyyy date format.
When I open the workbook, I want to automatically activate the Sheet that contains this cell (in my instance Cell N2) and Select it. I am truly a newbie learning slowly, but knowledge is minimal and can't find what I need. This what I have so far, but it doesn't work:
Sub ChooseSheet()
Dim SearchString As Variant
SearchString = "TODAY()" 'string I am searching for
Do Until SearchString = "TODAY()"
If Application.WorksheetFunction.CountIf(Sheets("Sheet1").Columns(14), SearchString) > 0 Then
Worksheets("Sheet1").Activate
End If
Exit Do
Loop
End Sub
This works for me.
Sub searchToday()
Dim sh As Worksheet
Dim found As Range
For Each sh In ActiveWorkbook.Worksheets
Set found = sh.Cells.Find(what:="=TODAY()", LookIn:=xlFormulas)
If Not found Is Nothing Then
sh.Activate
found.Select
Exit Sub
End If
Next sh
End Sub
Sub Test()
Dim ws As Worksheet
Dim f As Range
For Each ws In ActiveWorkbook.Worksheets
Set f = ws.Cells.Find(What:="=TODAY()", LookIn:=xlFormulas, LookAt:=xlWhole)
If Not f Is Nothing Then
ws.Activate
f.Select
Exit For
End If
Next ws
End Sub
Related
The first sub collects all the worksheets of the workbooks that are located in D:\Users\Cons\excel.
Then the second sub looks for the word "filename" in worksheet 2 then copies all the cells below to A2 in worksheet 3.
Finally the last sub should search for the word "apple" in e2:e100 in worksheet 3, and delete every row where "apple" is not found.
I have created 3 buttons and assigned the subs to each one of them. The first 2 runs fine, doing what I want, but when I click on the 3rd button (with 3rd sub behind), nothing happens,
only the first two buttons above are being shifted upwards, don't know why.
How can I combine all the 3 subs into one (that is actually working with a button click)? Thanks in advance!!!
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = "D:\Users\Cons\excel\"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
Worksheets(1).Activate
End Sub
Sub FindInFirstRow()
Dim fCell As Range
Dim strFind As String
Dim wsSource As Worksheet
Dim wsDest As Worksheet
'What shall we look for?
strFind = "filename"
'What sheet are we getting data from/to?
Set wsSource = Worksheets(2)
Set wsDest = Worksheets(3)
Set fCell = wsSource.Range("1:1").Find(what:=strFind, lookat:=xlPart, MatchCase:=False)
If fCell Is Nothing Then
MsgBox "No match found"
Else
'Copy the cells *below* to A2 of destination sheet
Intersect(wsSource.UsedRange.Offset(1), fCell.EntireColumn).Copy wsDest.Range("a2")
End If
End Sub
Sub SaveSomeRows()
Dim N As Long, L As Long, r As Range
Dim s As String, v As String
Set r = ActiveSheet.Range("e2", ActiveSheet.Range("e100").End(xlUp))
N = r.Count
s = "apple"
For L = N To 1 Step -1
v = LCase(r(L).Value)
If InStr(1, v, s) = 0 Then
r(L).EntireRow.Delete
End If
Next L
End Sub
Sub TheOneSub()
ConslidateWorkbooks
FindInFirstRow
SaveSomeRows
End Sub
Sub ConslidateWorkbooks()
...
End Sub
Sub FindInFirstRow()
...
End Sub
Sub SaveSomeRows()
...
End Sub
Sub combine_all()
Call ConslidateWorkbooks
Call FindInFirstRow
Call SaveSomeRows
'Runs them sequentially
End Sub
Assign this to a button , this would run (call) the other codes in sequence
I am trying to use VBA to loop through worksheets in my file but only those that are included in a list on a control worksheet, e.g.
Worksheet List
When I try to look up the worksheet name in this list, it does not recognise the worksheet name as a string.
Current code below:
I create a function to vlookup on the list:
Public Function IsInRunList(WsName As Variant, RunList As Range) As Boolean
If Application.VLookup(WsName, RunList, 1, False) = WsName Then
IsInRunList = True
End If
End Function
Then I call this function in my subroutine:
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If IsInRunList(Ws.Name, Range("Run_List").Columns(j)) Then
I get a mismatch error for Ws.Name here.
Any ideas?
Thanks.
Try the next approach, please:
Sub iterateBetweenSheetInList()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
Select Case sh.Name
Case "Sheet1", "Sheet2", "Sheet4", "Sheet7"
Debug.Print sh.UsedRange.Rows.Count
'your code can do here whatever you need...
End Select
Next
End Sub
Or a version to take the sheets name from a range (in column X:X in the code example). You did not show us in which column the sheets list exists:
Sub iterateBetweenSheetInListBis()
Dim sh As Worksheet, ws As Worksheet, arrSh As Variant, El As Variant
Set sh = ActiveSheet
'adapt the next range with the lettr of your column where the sheets name exists:
arrSh = sh.Range("X2:X" & sh.Range("X" & Rows.Count).End(xlUp).row).Value
For Each El In arrSh
Set ws = Worksheets(El)
Debug.Print ws.UsedRange.Rows.Count
'do here whatever you need...
Next
End Sub
Application.VLookup returns a Range when successful and an error if not (same behavior as in Excel). An error is not a string, it's a special type that you can check with IsError.
Change your checking routine to something like:
Public Function IsInRunList(WsName As Variant, RunList As Range) As Boolean
Dim res As Variant
res = Application.VLookup(WsName, RunList, 1, False)
IsInRunList = Not IsError(res)
End Function
I am using this code:
Function wrksht() as Variant
wrksht = Application.Caller.Parent.Name
End function
I am continuously being thrown
run time error '424' object not found
I have a workbook with several sheets, each having a date on it.
I want to populate the first column on every sheet with its sheet name.
Function wrksht() as String
wrksht = ActiveSheet.Name
End function
UPDATE
Function DoIt()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Sheets
sh.Range("A1") = sh.Name
Next
End Function
The above will work, but I have an easier solution:
=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255)
Paste this value (it is a formula, not VBA code) into the cell you wish to populate with the sheet name, and it will magically appear.
Try this
Sub my_macro
On error resume next
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
ws.Range("A1") = ws.Name
Next
End sub
I have a workbook that will contain worksheets with the text “benefits” in the sheet name. For example; MEDICALBenefits or DENTALBenefits. There will always be at least one, but there could be several.
I am trying to write a macro that will find the worksheet(s) with the text “benefits” in the sheet name AND at least one instance of the word TRUE in row 40.
When these two criteria are met then I need to create a new worksheet using the same worksheet name but replacing the text “Benefits” with the text “Final”, In other words; If the worksheet MEDICALBenefits has TRUE in one or more cells in row 40 then a new sheet called MEDICALFinal would be created.
Likewise, if the worksheet DENTALBenefits has TRUE in one or more cells in row 40 then a new sheet called DENTALFinal would be created.
I then need it to loop through all the sheets looking for “Benefits” in the name and TRUE in row 40 and create a new sheet.
This is the code I have so far, but need help with naming the new sheets.
Jordan
'Look for worksheet names *benefits* with checkbox(s) = true
Sub CreateFinalWorksheet()
Dim sh As Worksheet
Dim iVal As Integer
Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Sheets
iVal = Application.WorksheetFunction.CountIf(Range("40:40"), "TRUE")
If (LCase$(sh.Name) Like "*benefits*") And (iVal > 0) Then Call AddWorksheet
Next sh
Application.ScreenUpdating = True
End Sub
'Called from CreateFinalWorksheet.
'Add worksheet with same sheet name replacing *benefits* with *final*
Sub AddWorksheet()
Dim sh As Worksheet
With ThisWorkbook
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = "MedicalFinal"
End With
End Sub
edited after OPs clarification he wants to find all "*benefits" sheets
in
iVal = Application.WorksheetFunction.CountIf(Range("40:40"), "TRUE")
you're missing current sh worksheet reference, so you want to write as follows:
iVal = Application.WorksheetFunction.CountIf(sh.Range("40:40"), "TRUE")
For what above and for your main issue, I'd go like follows:
Sub CreateFinalWorksheet()
Dim sh As Worksheet
Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Sheets
If (LCase$(sh.Name) Like "*benefits") Then
If WorksheetFunction.CountIf(sh.Rows(40), "TRUE") = 0 Then AddWorksheet sh.Name
End If
Next sh
Application.ScreenUpdating = True
End Sub
Sub AddWorksheet(shtName As String)
Dim sh As Worksheet
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.count)).Name = Replace(LCase$(shtName), "benefits", "Final")
End With
End Sub
Add a parameter to your AddWorksheet routine, let it be the "benefits"worksheet
If (LCase$(sh.Name) Like "*benefits*") And (iVal > 0) Then AddWorksheet sh
Sub AddWorksheet(benef as worksheet)
....
ws.name = Replace(benef.name, "benefits", "Final", , vbTextCompare)
Eventually, you can also do other things inside this sub, such as copying some data from the parameter worksheet benef.
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