Email:      Pass:    Pass?
Close Window   
TE
Subscribe for Email Updates!
Excel tips, help, and more!
E-mail:


Advertisements


Free Excel Forum

Finding A Worksheet Starting With A Letter In Vba

Forum Register
Search Excel Forum Posts, Tutorials, Macros, Tips, and More

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

Helpful Excel Macros

Name Worksheets Based on Cell Contents
- This macro allows you to have your worksheets named by whatever is in a particular cell within a worksheet. This means
Delete All Chart Sheets in Excel - Only Chart Sheets are Deleted - Not Embedded Charts
- Delete all chart sheets and tabs in Excel using this macro. This will only delete the charts and graphs that are in the
Vlookup Function That Searches The Entire Workbook - UDF
- This UDF is a Vlookup function that searches the entire workbook in Excel. The syntax and usage of the function is exac
Delete Entire Rows Based on Predefined Criteria (Text)
- This macro will allow you to specify certain criteria and then to delete rows based upon that criteria. You will choose
Combine Multiple Workbooks into One
- This macro for Microsoft Excel allows you to combine multiple workbooks and worksheets into one new workbook and workshe

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