|
Finding A Worksheet Starting With A Letter In Vba
|
|
Search Excel Forum Posts, Tutorials, Macros, Tips, and More
Finding A Worksheet Starting With A Letter In Vba - Excel
|
View Answers
|
|
|
Hi,
I was wondering if anyone could help me out with a search/match question. I want to search through the sheets in a workbook and be able to see if one of them starts with a certain letter (such as M01, etc) have the code select that one as the active sheet. For example, if the sheets are T01, T02, T03, M01, M02, M03, I want to be able to check the sheets until I reach the one starting with "M" and select that.
i was trying to approach this by using:
Sub pickSheet()
Dim name As String
name = "M"
If SheetExists(name) Then
Worksheets(name).Activate
Else
' do nothing??
End If
End Sub
However, this chunk of code doesn't work. It doesn't realize when a sheet is named M01 that it starts with an M. Does anyone have any suggestions of things to try?
Similar Excel Video Tutorials
OFFSET Function Dynamic Range
- See how to use the OFFSET function for two different types of dynamic ranges for a chart: 1)Dynamic Range that adds latest records 2)Dynamic ...
Similar Topics
I have a workbook with 105 sheets in it and I need a way of searching for a particular string of numbers through all sheets and have the sheet names where the string is found returned in a list on a new sheet. I have this code from another post that gets me started:
Private Function SheetExists(SheetName As String) As Boolean
' Returns TRUE if a sheet exists in the active workbook
Dim x As Worksheet
On Error Resume Next
Set x = ActiveWorkbook.Sheets(SheetName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
Sub FindAllSheets()
Dim Found As Range, ws As Worksheet, LookFor As Variant
LookFor = InputBox("Enter value to find")
If LookFor = "" Then Exit Sub
' Clear or Add a Results sheet
If SheetExists("Search Results") Then
Sheets("Search Results").Activate
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Search Results"
End If
For Each ws In ActiveWorkbook.Worksheets
If ws.Name "Search Results" Then
Set Found = ws.Cells.Find(What:=LookFor)
If Found Is Nothing Then
Range("D5").Select
Else
Found.EntireRow.Copy Sheets("Search results").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
End If
Next ws
End Sub
i have the following code which searches through all the worksheets in a workbook for certain words that I enter in a search box. It works well but it will only post results for 3 instances only as if there is a limit set in the code. Why will it not list more than 3 results?
Private Function SheetExists(SheetName As String) As Boolean
Dim x As Worksheet
On Error Resume Next
Set x = ActiveWorkbook.Sheets(SheetName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
Sub FindAllSheets()
Dim Found As Range, ws As Worksheet, LookFor As Variant
LookFor = InputBox("Enter search criteria:")
If LookFor = "" Then Exit Sub
If SheetExists("Search Results") Then
Sheets("Search Results").Activate
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Search Results"
End If
For Each ws In ActiveWorkbook.Worksheets
If ws.Name "Search Results" Then
Set Found = ws.Cells.Find(What:=LookFor)
If Found Is Nothing Then
Range("D5").Select
Else
Found.EntireRow.Copy Sheets("Search results").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
End If
Next ws
End Sub
I have a little macro which sorts different parts of a worksheet. Each area to be sorted is identified by a Named Range, and the column to be sorted on is also Named. The macro processes all the sheets in the workbook (20-odd) doing a sort on anything from two or three up to about 25 different areas in each sheet, and it does this just by looping through all the Named Ranges, which have been generated by a previous process.
Each Name for an area to be sorted starts with the letter "I" and the Name of the sort key for that area is the same Name minus the initial "I" and suffixed with "Scr". Each "I" range has one associated "Scr" range. (There are other ranges starting with "T" which get processed differently.)
Here's my code, which does the job:
Code:
Dim nName As Name, stKeyRange As String, stSht As String
Application.ScreenUpdating = False
For Each nName In Names
If Mid(nName.Name, 1, 1) = "I" Then
stSht = nName.RefersToRange.Parent.Name
Sheets(stSht).Select
stKeyRange = Range(Mid(nName.Name, 2) & "Scr").Address
Range(nName.Name).Sort key1:=Range(stKeyRange), Order1:=xlDescending '
End If
Next
This fails if the line "Sheets(stSht).Select" is not present. i.e. the Named Ranges are not accessible unless the sheet they belong to is the active sheet. Why not? I thought Named Ranges were global. Isn't that why their Scope is described as "Workbook"?
I tried prepending the sheet name to the Range name in the Sort (e.g. to give "sheetname!rangename"), but that didn't work either.
I would appreciate any suggestions about how to structure this so I don't have to do a Select on each sheet
I have a little macro which sorts different parts of a worksheet. Each area to be sorted is identified by a Named Range, and the column to be sorted on is also Named. The macro processes all the sheets in the workbook (20-odd) doing a sort on anything from two or three up to about 25 different areas in each sheet, and it does this just by looping through all the Named Ranges, which have been generated by a previous process.
Each Name for an area to be sorted starts with the letter "I" and the Name of the sort key for that area is the same Name minus the initial "I" and suffixed with "Scr". Each "I" range has one associated "Scr" range. (There are other ranges starting with "T" which get processed differently.)
Here's my code, which does the job:
Code:
Dim nName As Name, stKeyRange As String, stSht As String
Application.ScreenUpdating = False
For Each nName In Names
If Mid(nName.Name, 1, 1) = "I" Then
stSht = nName.RefersToRange.Parent.Name
Sheets(stSht).Select
stKeyRange = Range(Mid(nName.Name, 2) & "Scr").Address
Range(nName.Name).Sort key1:=Range(stKeyRange), Order1:=xlDescending '
End If
Next
This fails if the line "Sheets(stSht).Select" is not present. i.e. the Named Ranges are not accessible unless the sheet they belong to is the active sheet. Why not? I thought Named Ranges were global. Isn't that why their Scope is described as "Workbook"?
I tried prepending the sheet name to the Range name in the Sort to give "sheetname!rangename", and even extracted the cell address from the range to give "sheetname!A5:H11", but these didn't work either.
I would appreciate any suggestions about how to structure this so I don't have to do a Select on each sheet.
I have tried many ways to use code to check if a sheet exists and, if it doesn't to create that sheet. Lots of searching of this forum and Google keeps leading to me code similar to the following which looks logical to me:
Code:
Function SheetExists(SheetName As String) As Boolean
' returns TRUE if the sheet exists in the active workbook
SheetExists = False
On Error GoTo NoSuchSheet
If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If
NoSuchSheet:
End Function
Example:
If Not SheetExists("MySheetName") Then
MsgBox "MySheetName doesn't exist!"
Else
Sheets("MySheetName").Activate
End If
However I get error code Run-time error '9' Subscript out of range whenever I run this?
Could you make that search box to work.
Suppose the letter I'd be looking for is "Eagle" from column A
WHAT I HAVE:
Clicing "E" with mouse on search box only takes me to that value that starts up with the letter E. meaning the row 16 gets selected.
WHAT I NEED:
But what if i type Ea in search box with first letter same"E" but the second letter to look for is "a". This should take me to the row below... which is row 17.
Excel should know if there is changes in search box and count the number of letters to look for a match when searching in column A.
Note: there is no need to press any button to execute the command. As soon as something is written in search box it should GoTo that word in real time..means if now i backspace once on search box excel should select row 16 again..
Hi,
I'm using the following code to search about 1400 sheets for a particular part number. When all occurences of that number have been found and pasted inot the search results sheet, then the next 3 macros run in order to do lots of other things which are irrelevant to the question. If the search finds no results, I want the macro to stop and display something like Part Number not found, and ignore the other 3 macros.
Thanks for looking, any help greatly appreciated.
Here's the code I'm using
Sub FindAllSheets()
Dim Found As Range, WS As Worksheet, LookFor As Variant
LookFor = InputBox("Enter value to find")
If LookFor = "" Then Exit Sub
' Clear or Add a Results sheet
If SheetExists("Search Results") Then
Sheets("Search Results").Activate
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Range("H1").Select
Selection.ClearContents
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Search Results"
End If
For Each WS In ActiveWorkbook.Worksheets
If WS.Name "Search Results" Then
Set Found = WS.Cells.Find(What:=LookFor)
If Found Is Nothing Then
Range("D5").Select
Else
Found.EntireRow.Copy Sheets("Search results").Cells(Rows.Count, "A").End(xlUp).Offset(1)
Found.EntireRow.Interior.Color = vbYellow
End If
End If
Next WS
Sheets("Search Results").Activate
Columns("A:G").Select
Selection.Columns.AutoFit
Range("B2").Select
Call ADMIN_HYPERS
Call Replace
Call FIND_DOCUMENTS
End Sub
Hello All
I have a workbook with 50 worksheets and they are called 1 through to 45 the remaining 5 are called other things that are not numbers.
So in the cell A1 of sheets 1 through to 45 I have something entered like this E1 (in sheet 1) E2 (in sheet 2) E3 (in sheet 3) and so through to sheet 45 and the cell would have E45.
Now I need to find a way to change the letter E on all the sheets sometimes to another letter say F so sheet 1 would say F1 instead of E1. This can be done with a user form or I can change some code manually to suit.
I have tried to make all the req sheets active and changing the letter but does not work for me in Excel 2003.
Any help would be usefull
Thanks
Hi,
I have two macros, both containing functions that I can run seperately and they work fine. The first macro is run from a command button. What I want to do is run the second macro when the first has completed without having select and run the second macro, but I don't know how to combine the two.
First Macro Code
Private Function SheetExists(SheetName As String) As Boolean
' Returns TRUE if a sheet exists in the active workbook
Dim x As Worksheet
On Error Resume Next
Set x = ActiveWorkbook.Sheets(SheetName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
Sub FindAllSheets()
Dim Found As Range, ws As Worksheet, LookFor As Variant
LookFor = InputBox("Enter value to find")
If LookFor = "" Then Exit Sub
' Clear or Add a Results sheet
If SheetExists("Search Results") Then
Sheets("Search Results").Activate
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Search Results"
End If
For Each ws In ActiveWorkbook.Worksheets
If ws.Name "Search Results" Then
Set Found = ws.Cells.Find(what:=LookFor)
If Found Is Nothing Then
Range("D5").Select
Else
Found.EntireRow.Copy Sheets("Search results").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
End If
Next ws
End Sub
Second Macro code is
Sub ADMIN_HYPERS()
'==========================================
'DEFINE (& ASSIGN) VARIABLES
'==========================================
Dim s1 As String: s1 = "Search Results"
Dim co_1 As Integer: co_1 = 3 'row containing values to assess
Dim rw_1 As Long: rw_1 = 1 'first row in range containing possible hyperlink
Dim rw_2 As Long: rw_2 = Sheets(s1).UsedRange.Rows.Count
Dim h_val As Variant
Dim e As Variant
'==========================================
'LOOP DEPTS & ADD LINKS
'==========================================
Do Until rw_1 > rw_2
h_val = CStr(Sheets(s1).Cells(rw_1, co_1))
On Error GoTo Handler:
e = Sheets(h_val).Cells(1, 1)
Select Case CStr(e)
Case "1"
'do nothing -- error
Case Else
Sheets(s1).Hyperlinks.Add anchor:=Sheets(s1).Cells(rw_1, co_1), _
Address:="", _
SubAddress:="#'" & h_val & "'!A1", _
TextToDisplay:=h_val
End Select
e = 0
On Error GoTo 0
rw_1 = rw_1 + 1
Loop
'==========================================
'END
'==========================================
Exit Sub
Handler:
e = 1
Resume Next
End Sub
Function GET_COL(s1 As String, crit As Variant, rw As Long, m_ord As Integer)
GET_COL = Application.WorksheetFunction.Match(crit, Sheets(s1).Rows(rw), m_ord)
End Function
Function GET_ROW(s1 As String, crit As Variant, co As Integer, m_ord As Integer)
GET_ROW = Application.WorksheetFunction.Match(crit, Sheets(s1).Columns(co), m_ord)
End Function
Any help would be greatly appreciated. Thanks for looking
Hi,
I have two macros, both containing functions that I can run seperately and they work fine. The first macro is run from a command button. What I want to do is run the second macro when the first has completed without having select and run the second macro, but I don't know how to combine the two.
First Macro Code
Private Function SheetExists(SheetName As String) As Boolean
' Returns TRUE if a sheet exists in the active workbook
Dim x As Worksheet
On Error Resume Next
Set x = ActiveWorkbook.Sheets(SheetName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
Sub FindAllSheets()
Dim Found As Range, ws As Worksheet, LookFor As Variant
LookFor = InputBox("Enter value to find")
If LookFor = "" Then Exit Sub
' Clear or Add a Results sheet
If SheetExists("Search Results") Then
Sheets("Search Results").Activate
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Search Results"
End If
For Each ws In ActiveWorkbook.Worksheets
If ws.Name "Search Results" Then
Set Found = ws.Cells.Find(what:=LookFor)
If Found Is Nothing Then
Range("D5").Select
Else
Found.EntireRow.Copy Sheets("Search results").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
End If
Next ws
End Sub
Second Macro code is
Sub ADMIN_HYPERS()
'==========================================
'DEFINE (& ASSIGN) VARIABLES
'==========================================
Dim s1 As String: s1 = "Search Results"
Dim co_1 As Integer: co_1 = 3 'row containing values to assess
Dim rw_1 As Long: rw_1 = 1 'first row in range containing possible hyperlink
Dim rw_2 As Long: rw_2 = Sheets(s1).UsedRange.Rows.Count
Dim h_val As Variant
Dim e As Variant
'==========================================
'LOOP DEPTS & ADD LINKS
'==========================================
Do Until rw_1 > rw_2
h_val = CStr(Sheets(s1).Cells(rw_1, co_1))
On Error GoTo Handler:
e = Sheets(h_val).Cells(1, 1)
Select Case CStr(e)
Case "1"
'do nothing -- error
Case Else
Sheets(s1).Hyperlinks.Add anchor:=Sheets(s1).Cells(rw_1, co_1), _
Address:="", _
SubAddress:="#'" & h_val & "'!A1", _
TextToDisplay:=h_val
End Select
e = 0
On Error GoTo 0
rw_1 = rw_1 + 1
Loop
'==========================================
'END
'==========================================
Exit Sub
Handler:
e = 1
Resume Next
End Sub
Function GET_COL(s1 As String, crit As Variant, rw As Long, m_ord As Integer)
GET_COL = Application.WorksheetFunction.Match(crit, Sheets(s1).Rows(rw), m_ord)
End Function
Function GET_ROW(s1 As String, crit As Variant, co As Integer, m_ord As Integer)
GET_ROW = Application.WorksheetFunction.Match(crit, Sheets(s1).Columns(co), m_ord)
End Function
Any help would be greatly appreciated. Thanks for looking
Hey all
I have an archive workbook which is updated with new sheets every month or so, each sheet being pretty similar.
What is the general argument if I want to perform functions across multiple sheets, starting from (codename) Sheet3 to the last sheet?
Sheets 1 and 2 are data/input sheets. Sheets3 - infinite are the archived sheets (again - codenames; the sheet names are things like 'schedule Oct 2009')
So I imagine it's something like
Code:
For each ws in Worksheets
'do something
Next
but I need to know how to say 'don't do the first two worksheets, and don't stop until you reach the last worksheet'
Help
c
Hi,
I'm using the code below to find all references in an Excel workbook and paste them onto a results sheet (Search Results), then I use the contents of cell B2 to search an external folder for matching documents. I have just discovered that all the results from the workbook are in a 01069701-0077 format, but some of the documents are in a 01069701.0077 format (dash replaced by dot) and consequently don't get found. Is there any way to get around this, I've tried just searching for the first or last part of the number, but it returns too many results.
Private Function SheetExists(SheetName As String) As Boolean
' Returns TRUE if a sheet exists in the active workbook
Dim x As Worksheet
On Error Resume Next
Set x = ActiveWorkbook.Sheets(SheetName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
Sub FindAllSheets()
Dim Found As Range, WS As Worksheet, LookFor As Variant
LookFor = InputBox("Enter value to find")
If LookFor = "" Then Exit Sub
' Clear or Add a Results sheet
If SheetExists("Search Results") Then
Sheets("Search Results").Activate
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Search Results"
End If
For Each WS In ActiveWorkbook.Worksheets
If WS.Name "Search Results" Then
Set Found = WS.Cells.Find(what:=LookFor)
If Found Is Nothing Then
Range("D5").Select
Else
Found.EntireRow.Copy Sheets("Search results").Cells(Rows.Count, "A").End(xlUp).Offset(1)
Found.EntireRow.Interior.Color = vbYellow
End If
End If
Next WS
Sheets("Search Results").Activate
Columns("A:G").Select
Selection.Columns.AutoFit
Range("A2").Select
Call FIND_DOCUMENTS
End Sub
=============================================================================
'- SEARCH ALL FILES IN A FOLDER & FIND STRING IN FILE NAME
'- PUT NAMES INTO ACTIVE SHEET AT BOTTOM OF COLUMN A
'- (search is not case sensitive)
'& #39;============================================================================
=
Dim FoundRow as integer=1
Sub FIND_DOCUMENTS()
Dim FindText As String
Dim MyFolder As String
Dim MyFileCount As Integer
Dim MyFileName As String
Dim MyFileType As String
Dim f
Dim WS As Worksheet
'-------------------------------------------------------------------------
'- SET VARIABLES
Set WS = ActiveSheet
MyFolder = "H:\SERVICE CENTRE DETAILS\INSPECTION DRAWINGS and DOCUMENTS"
FindText = WS.Range("B2").Value
MyFileType = "*" & FindText & "*.*" ' = "*Test*.*"
'-------------------------------------------------------------------------
'- CHECK FILE NAMES
With Application.FileSearch
.NewSearch
.LookIn = MyFolder
.Filename = MyFileType
.SearchSubFolders = True ' True to search subfolders
'---------------------------------------------------------------------
'- RESULTS
MyFileCount = 0
If .Execute() > 0 Then
MyFileCount = .FoundFiles.Count
For f = 1 To MyFileCount
FoundRow = FoundRow + 1
MyFileName = .FoundFiles(f)
WS.Range("H" & CStr(FoundRow)).Value = WS.Range("H" & CStr(FoundRow)).Value & " " & MyFileName
WS.Hyperlinks.Add anchor:=WS.Range("H" & CStr(FoundRow)), Address:=MyFileName, TextToDisplay:="Document"
Next
Else
MsgBox ("Search for file names containing : " & FindText & vbCr _
& "No matches found")
Exit Sub
End If
End With
'--------------------------------------------------------------------------
'- finish
MsgBox ("Found " & MyFileCount & " file names.")
End Sub
Any help would be greatly appreciated
Regards
Paul
Hello,
in Excel 2003 I want to adjust the code of my userform and would need a little help on two issues.
The following code attached to a userform displays the sheetnames of all sheets in the active workbook.
Code:
Option Explicit
Private bolInitial As Boolean
Private Sub CB_Abbrechen_Click()
Unload Me
End Sub
Private Sub CB_Anzeigen_Click()
Sheets(Me.ListBox1.Value).Activate
Unload Me
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If bolInitial = False Then
Sheets(Me.ListBox1.Value).Activate
Unload Me
End If
End Sub
Private Sub UserForm_Initialize()
Dim objSheet As Object
bolInitial = True
For Each objSheet In ActiveWorkbook.Sheets
Me.ListBox1.AddItem objSheet.Name
Next
Me.ListBox1.Value = ActiveSheet.Name
bolInitial = False
End Sub
1) Instead of the ListBox1_DblClick Event I want to activate a sheet via the Enter button. Why does ListBox1_Enter not work? What am I overseeing?
2) I can navigate through the sheetnames in the box using the letter keys. That is, pressing P jumps to the first sheet in the list starting with P. When pressing the P key again, I want it to jump to the next sheet starting with P. Currently, it stays at the first sheet starting with the letter no matter how often I press the key.
Could anybody help me resolve these issues?
regards, Haui
Hi all
I'm trying to create a dynamic array so that when a user enters the first sheet name via an input box, excel will know to select the other sheets with ending (2), (3), (4) etc.
Currently this code works only if there are 4 sheets present (as I set this way), anything lower/higher is out of range.
How do I make it so that it will select sheets if there are less than 4 sheets present?
I tried nesting, but I pretty sure this array needs redimming or something. Is ubound a better option?
Any input would be most helpful!
Cheers
Danny
Code:
Option Explicit
Option Base 0
Function SheetExists(SheetName As String) As Boolean
'returns TRUE if the sheet exists in the active workbook
SheetExists = False
On Error GoTo NoSuchSheet
If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If
NoSuchSheet:
End Function
Sub testarray()
Dim x(3)
Dim strname As String
Dim ThisBook As Workbook, WkSht As Worksheet
Set ThisBook = ThisWorkbook
strname = UCase(InputBox(Prompt:="Please main sheet name.", _
Title:="User Code Input"))
If Not SheetExists(strname) Then
MsgBox strname & " doesn't exist!"
Else
x(0) = strname: x(1) = strname & " (2)": x(2) = strname & " (3)": x(3) = strname & " (4)"
Sheets(x).Select
End If
End Sub
I got the following code from another post, but it Combines ALL the worksheets in my workbook. Is there a way to...
1. Already have a tab called Combined instead of it creating it.
2. Delete all data from A3...down...
3. Copy the data from all the worksheets that contain the same headers (excluding TEMPLATE worksheet) as the Combine header and paste it in the Combine worksheet.
Yes, I can create a macro, but new tabs are always being created and there are other tabs with other information (News, etc...). Here's the code I WAS using, but I need it to do the above. My headers are in A2 across with data starting in A3.
Thanks!
Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A2").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A2")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("A3").Select
Selection.CurrentRegion.Select ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
Is this the right way to check? in case if it errors due to no Sheet existance?
Thanks for helping!!!
Code:
Private Function SheetExists(sName) As Boolean
' Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
Sub Demo()
Dim sName$
With ActiveWorkbook
sName = "Sheet1"
If SheetExists(sName) Then
MsgBox "yes"
Sheets(sName).Activate
Range("A1").Value = "'--------------"
Else
MsgBox "NO" & sName
End If
sName = "Sheet2"
If SheetExists(sName) Then
MsgBox "yes"
Sheets(sName).Activate
Range("A1").Value = "'--------------"
Else
MsgBox "NO" & sName
End If
sName = "Sheet3"
If SheetExists(sName) Then
MsgBox "yes"
Sheets(sName).Activate
Range("A1").Value = "'--------------"
Else
MsgBox "NO" & sName
End If
End With
I am working on a macro to make excel a lookup tool. I have a master sheet built and will have 20+ sheets in the workbook. I want the master sheet to be the look up/data entry point. Once data is input and the search button is hit it will search the pages and find the match. If multiple matches are found, a pop up will appear to select which option sheet to go to. I have a very basic code started below. But it will get massive if I have to write this script out for each sheet. So below are my issues, and then my code. (I am using Excel 2007)
1. Can I simplify the code to search through each sheet without typing it out long as it is now?
2. Can it be made if multiple search criteria is input, to search for the first, if nothing found, then search the next data? (If searching and only finding sheets that match both could be done that would be awesome)
3. Can a pop up be done to give the options for multiple results, then have it capable of being selected to go to that sheet?
4. Is there a way to make the search not be case specific? (my current code wouldn't find the word job because I capitalized the J in one place and not the other)
Thank you anyone who can help me!
My code:
VB:
Sub Search()
If Range("g6") <> "" Then
If Sheets("sheet2").Range("b1") = Range("g6") Then
Sheets("sheet2").Select
ElseIf Sheets("sheet3").Range("b1") = Range("g6") Then
Sheets("sheet3").Select
ElseIf Range("g6") <> "" Then
MsgBox "Your Search Returned No Jobs, Please Try Again..."
End If
ElseIf Range("g8") <> "" Then
If Sheets("sheet2").Range("b5") = Range("g8") Then
Sheets("sheet2").Select
ElseIf Sheets("sheet3").Range("b5") = Range("g8") Then
Sheets("sheet3").Select
ElseIf Range("g8") <> "" Then
MsgBox "Your Search Returned No Jobs, Please Try Again..."
End If
ElseIf Range("g10") <> "" Then
If Sheets("sheet2").Range("b10") = Range("g10") Then
Sheets("sheet2").Select
ElseIf Sheets("sheet3").Range("b10") = Range("g10") Then
Sheets("sheet3").Select
ElseIf Range("g10") <> "" Then
MsgBox "Your Search Returned No Jobs, Please Try Again..."
End If
ElseIf Range("g12") <> "" Then
If Sheets("sheet2").Range("e3") = Range("g12") Then
Sheets("sheet2").Select
ElseIf Sheets("sheet3").Range("e3") = Range("g12") Then
Sheets("sheet3").Select
ElseIf Range("g12") <> "" Then
MsgBox "Your Search Returned No Jobs, Please Try Again..."
End If
ElseIf Range("g12") <> "" Then
MsgBox "Your Search Returned No Jobs, Please Try Again..."
End If
End Sub
If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines
I have 3 different excel sheets and data in each sheet starts from b5:q5. In a1 to b4 there is some other data. All i want is to copy the data from b5:q5 from all the three sheets and consolidate into one sheet. I have used the following macro but i am not getting the output properly. Can anyone please help me on this.
Thanks
sansri
Code:
Private Sub CommandButton1_Click()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("b5:q5").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("a1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
Sheets(J).Activate ' make the sheet active
Range("b5").Select
Selection.CurrentRegion.Select ' select all cells in this sheets
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
Hi,
I want a code to run some type of a lookup which would bring up all the information, specific cells within the row of the name I type in to a sheet named "Search".
Looking in several sheets named "??? Register" (the 3 question marks will be different letters or numbers on each Register sheet) starting in row 137.
If the name does exist I want the information from each time the name is found, from columns B, C, D, E, G, H, & I to be listed on the Search sheet.
If the name doesn't exist on the ??? Register sheets I would like a pop up to open and indicates "Name not found" or "Name doesn't exist".
Is this possible??
I am working on a macro to make excel a lookup tool. I have a master sheet built and will have 20+ sheets in the workbook. I want the master sheet to be the look up/data entry point. Once data is input and the search button is hit it will search the pages and find the match. If multiple matches are found, a pop up will appear to select which option sheet to go to. I have a very basic code started below. But it will get massive if I have to write this script out for each sheet. So below are my issues, and then my code. (I am using Excel 2007)
1. Can I simplify the code to search through each sheet without typing it out long as it is now?
2. Can it be made if multiple search criteria is input, to search for the first, if nothing found, then search the next data? (If searching and only finding sheets that match both could be done that would be awesome)
3. Can a pop up be done to give the options for multiple results, then have it capable of being selected to go to that sheet?
4. Is there a way to make the search not be case specific? (my current code wouldn't find the word job because I capitalized the J in one place and not the other)
Thank you anyone who can help me!
My code:
Sub Search()
If Range("g6") "" Then
If Sheets("sheet2").Range("b1") = Range("g6") Then
Sheets("sheet2").Select
ElseIf Sheets("sheet3").Range("b1") = Range("g6") Then
Sheets("sheet3").Select
ElseIf Range("g6") "" Then
MsgBox "Your Search Returned No Jobs, Please Try Again..."
End If
ElseIf Range("g8") "" Then
If Sheets("sheet2").Range("b5") = Range("g8") Then
Sheets("sheet2").Select
ElseIf Sheets("sheet3").Range("b5") = Range("g8") Then
Sheets("sheet3").Select
ElseIf Range("g8") "" Then
MsgBox "Your Search Returned No Jobs, Please Try Again..."
End If
ElseIf Range("g10") "" Then
If Sheets("sheet2").Range("b10") = Range("g10") Then
Sheets("sheet2").Select
ElseIf Sheets("sheet3").Range("b10") = Range("g10") Then
Sheets("sheet3").Select
ElseIf Range("g10") "" Then
MsgBox "Your Search Returned No Jobs, Please Try Again..."
End If
ElseIf Range("g12") "" Then
If Sheets("sheet2").Range("e3") = Range("g12") Then
Sheets("sheet2").Select
ElseIf Sheets("sheet3").Range("e3") = Range("g12") Then
Sheets("sheet3").Select
ElseIf Range("g12") "" Then
MsgBox "Your Search Returned No Jobs, Please Try Again..."
End If
ElseIf Range("g12") "" Then
MsgBox "Your Search Returned No Jobs, Please Try Again..."
End If
End Sub
Hi Everyone,
I have a macro that is running fine, the basics are that it searches for the first empty cell in column A, selects the range between it and the last cell, copies it, and pastes it into a results sheet. The top section of the source sheets are bordered, and the bottom section that I'm copying is not bordered. This works fine while ever there is a non bordered section to copy, but not all sheets have this, so when the first empty cell is selected, it is actually one row lower than the last cell, and it copiies the last bordered row of the upper section. What I would like to do is put some sort of check in the code to make sure that the last cell is further down the sheeet than the first empty, selected cell. If that is the case, continue with the code, if not, move onto the next sheet without copying anything.
Hope someone can help with this, it's driving me crazy.
Here's my code.
Sub Generate_Repair_Kit_List()
'
'
' Clear or Add a Results sheet
If SheetExists("List") Then
Sheets("List").Activate
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "List"
End If
On Error Resume Next
For Each ws In Sheets
ws.Activate
If ActiveSheet.Name "List" Then
' execute code
End If
Cells(Rows.Count, "A").End(xlUp).Offset(0).Select
Selection.CopyRange(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Sheets("List").Activate
Range("C65366").End(xlUp).Offset(2, -2).Select
ActiveSheet.Paste
Columns("A:F").Select
Selection.Columns.AutoFit
End If
Next ws
Set CurSheet = ActiveSheet
Sheets.Select
Range("A1").Select
Selection.ClearContents
CurSheet.Activate
End Sub
Private Function SheetExists(SheetName As String) As Boolean
' Returns TRUE if a sheet exists in the active workbook
Dim x As Worksheet
On Error Resume Next
Set x = ActiveWorkbook.Sheets(SheetName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
Regards Paul
If I am selcting cells on a non-active worksheet, I now do something like this (below) as the qwuickest way to select the cell:
Code:
Sheets("Sheet2").Activate
[A1].Select
Without asking why I am "Selecting" vs. Activating the cells (there are several reasons for this particular thing I am doing), I'm just wondering is there a single line of code (versus my 2 line method of code written above) which will SELECT (not Activate) the given cell on a NON ACTIVE worksheet? In other words, this will NOT work if Sheet2 is NOT the active sheet:
Code:
'This will NOT work if Sheet2 is NOT the active sheet
Sheets("Sheet2").[A1].Select
I'm hoping there is something like this syntax (above) that will work to activate and select a cell on a non-active sheet???
Thank You,
Matt[/code]
Hi Guys & Gals,
I now have my macro running as I want it, this macro goes through all the sheets of my workbook and looks for a non-bordered section at the bottom of the sheet and copies it into another sheet in list form. I look for the first empty cell in column A and select the range between that and the last cell of the sheet. The problem is that not all sheets have the non-bordered list so when the macro runs on that sheet, it selects from the first empty cell in column A UP to the last cell, i.e. 2 rows of nothing I require. Is there any way I can tweak my code to take this into account and ignore if the last cell is above the selected cell? If it helps any, where there is something I want to copy, there will be at least 4 rows to copy, being made up of No Data, Data, No Data, Data from top to bottom.
Thanks for looking, hope somenone can help me.
Here's my code
Sub Generate_Repair_Kit_List()
'
'
' Clear or Add a Results sheet
If SheetExists("List") Then
Sheets("List").Activate
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "List"
End If
Dim ws As Worksheet
For Each ws In Sheets
With ws
If ws.Name ("List") Then
ws.Activate
Cells(Rows.Count, "A").End(xlUp).Offset(1).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets("List").Activate
Range("C65366").End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste
Columns("A:F").Select
Selection.Columns.AutoFit
End If
End With
Next ws
End Sub
Private Function SheetExists(SheetName As String) As Boolean
' Returns TRUE if a sheet exists in the active workbook
Dim x As Worksheet
On Error Resume Next
Set x = ActiveWorkbook.Sheets(SheetName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function
What is the syntax to check to cee if a sheet exists in the current workbook.
If it Exists then delete Else Create.
Thanks Charlie Crimmel
Sub InsertBIDTab()
Dim shtName As String
Dim sheetExists As Boolean
shtName = "BID TEST"
sheetExists = ActiveWorkbook.Sheets(shtName).Name ""
If sheetExists = "True" Then
Sheets("BID TEST").Select
ActiveWindow.SelectedSheets.Delete
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet2").Name = "BID TEST"
Range("A1").Select
Else
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet2").Name = "BID TEST"
Range("A1").Select
End If
End Sub
This site has got me hooked on using VB ... Thank you!! Usually I can find my answers in the archieves, but today I am having trouble. Hopefully someone can help with this problem.
I have a workbook that is used by several people. To maintain its size I use command buttons to save completed sheets and save them to a folder as individual files. These Sheets are orders we run throughout the day, each are renamed automatically by a cell value. I use a command button to add more sheets as more orders come in. Sheets are created by a hidden sheet and named accordingly.
I simply want to move these sheets to the end via VB ... Please Help
(As you view the code you can see that all the new sheets are selected together. All I have to do is send them to the end, but inevitably someone will mess the whole thing up!!!)
Sub ADD4()
On Error GoTo AddSheetsFinalize
Sheets("Sheet (A)").Visible = True
Sheets("Sheet (A)").Select
Sheets("Sheet (A)").Copy Befo =Sheets(1)
Sheets("Sheet (A) (2)").Select
Sheets("Sheet (A) (2)").Name = "Sheet (1)"
Sheets("Sheet (A)").Select
Sheets("Sheet (A)").Copy Befo =Sheets(2)
Sheets("Sheet (A) (2)").Select
Sheets("Sheet (A) (2)").Name = "Sheet (2)"
Sheets("Sheet (A)").Select
Sheets("Sheet (A)").Copy Befo =Sheets(3)
Sheets("Sheet (A) (2)").Select
Sheets("Sheet (A) (2)").Name = "Sheet (3)"
Sheets("Sheet (A)").Select
Sheets("Sheet (A)").Copy Befo =Sheets(4)
Sheets("Sheet (A) (2)").Select
Sheets("Sheet (A) (2)").Name = "Sheet (4)"
AddSheetsFinalize:
Sheets("Sheet (A)").Visible = False
Sheets(Array("Sheet (1)", "Sheet (2)", "Sheet (3)", "Sheet (4)")).Select
Sheets("Sheet (1)").Activate
Somewhere here I need the code to send these 4 sheets to the end of the workbook!
ActiveWorkbook.Save
End Sub
CalB
|
|
