Free Microsoft Excel 2013
Quick Reference
Free Microsoft 2013 Quick Reference Guide

Free Microsoft Excel 2013 Quick Reference

Set several macros to run from one command button.

I have a spreadsheet that has several macros (below) that need to run in the order below from one click of a command button. How do you get them all attached or combined to run together?

Code:
 
Option Explicit
Private Sub CommandButton1_Click()
  Dim OutSH As Worksheet, TemplateSH As Worksheet, ce As Variant
  Dim DataCol As Integer, OutRow As Long, i As Long
  Dim arr As Variant
  Set OutSH = Sheets("Internal Project Plan")
  Set TemplateSH = Sheets("Master Template")
 
  For Each ce In Range("B13:B80")
    If ce = "Yes" Then
      DataCol = WorksheetFunction.Match(ce.Offset(0, -1).Value, TemplateSH.Rows("1:1"), 0)
      With TemplateSH
        For i = 2 To 700
          If .Cells(i, DataCol).Value = "x" Then
          'check to see if it already exists and only proceed if it does not
            If WorksheetFunction.CountIf(OutSH.Range("A:A"), TemplateSH.Cells(i, 1).Value) = 0 Then
              OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
              OutSH.Cells(OutRow, 1).Value = .Cells(i, 1).Value
              OutSH.Cells(OutRow, 2).Value = .Cells(i, 4).Value
              OutSH.Cells(OutRow, 3).Value = .Cells(i, 10).Value
              OutSH.Cells(OutRow, 4).Value = .Cells(i, 5).Value
              OutSH.Cells(OutRow, 10).Value = .Cells(i, 63).Value
            End If
          End If
        Next i
      End With
    End If
  Next ce
  Application.StatusBar = "Transferring Headings"
  arr = Array(2, 15, 77, 87, 461, 507, 534, 553, 582)
  With TemplateSH
    For i = LBound(arr) To UBound(arr)
      OutRow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
      .Cells(arr(i), 1).Copy Destination:=OutSH.Cells(OutRow, 1)
      OutSH.Cells(OutRow, 1).Value = .Cells(arr(i), 1).Value
      .Cells(arr(i), 4).Copy Destination:=OutSH.Cells(OutRow, 2)
      OutSH.Cells(OutRow, 2).Value = .Cells(arr(i), 4).Value
      .Cells(arr(i), 10).Copy Destination:=OutSH.Cells(OutRow, 3)
      OutSH.Cells(OutRow, 3).Value = .Cells(arr(i), 10).Value
      .Cells(arr(i), 5).Copy Destination:=OutSH.Cells(OutRow, 4)
      OutSH.Cells(OutRow, 4).Value = .Cells(arr(i), 5).Value
      .Cells(arr(i), 63).Copy Destination:=OutSH.Cells(OutRow, 10)
      OutSH.Cells(OutRow, 10).Value = .Cells(arr(i), 63).Value
    Next i
  End With
  'sort output data
  Application.StatusBar = "Sorting Output"
  With OutSH
    .Range("A6:J" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort key1:=.Range("A6"), order1:=xlAscending, header:=xlYes
 
  End With
    Application.StatusBar = False
 
With ActiveSheet
    For i = 7 To Range("B" & Rows.Count).End(xlUp).Row
        .Range("E" & i & ":I" & i).Interior.ColorIndex = .Range("B" & i).Interior.ColorIndex
    Next i
End With
End Sub
Code:
 
Option Explicit
Sub Colors()
Dim i As Long
With ActiveSheet
    For i = 7 To Range("B" & Rows.Count).End(xlUp).Row
        .Range("E" & i & ":I" & i).Interior.ColorIndex = .Range("B" & i).Interior.ColorIndex
    Next i
End With
End Sub
Code:
 
Sub SaveAs()
ActiveWorkbook.SaveAs Filename:="osshareteamproject" & Range("SAVE").Value & ".xls"
End Sub
Thank you for all your help. I really appreciate it.


Post your answer or comment

comments powered by Disqus
I've got a problem with the following macro(plagarised from this very board!). It runs perfectly when I call it from the menu, but as soon as I run it from a command button to it it gives a Run-time error '1004'
Unable to set the verticalAlignment property of the Oval class.

Is it something I'm doing wrong or is it just impossible to run from a button?

Thanks

GaryB

Sub Show_Message()

ActiveSheet.Shapes.AddShape(msoShapeOval, 169.5, 76.5, 350#, 72#).Select
With Selection
.Characters.Text = "The Backlog Summary has been successfully updated."
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
With .ShapeRange
.Fill.ForeColor.SchemeColor = 26
.Line.Weight = 1.75
.Line.ForeColor.SchemeColor = 14
End With
With .Font
.FontStyle = "Bold Italic"
.ColorIndex = 49
End With
Application.Wait Now() + TimeValue("0:0:03")
.Cut
End With
End Sub

[ This Message was edited by: GaryB on 2002-11-28 06:36 ]

I have created macros that I would like to run when a command button (placed
on the excel worksheet) is clicked. How can I do this?

I have a macro that ideally would run automatically whenever the user closes
out of the workbook. I know how to set a macro to run this way when OPENING
the workbook, but is the reverse possible?

I have created macros that I would like to run when a command button (placed
on the excel worksheet) is clicked. How can I do this?

I have a macro that ideally would run automatically whenever the user closes
out of the workbook. I know how to set a macro to run this way when OPENING
the workbook, but is the reverse possible?

Hi,

I've done quite a bit of searching in the forum and online and haven't found anything that's generic and can be used at anytime.

What I'm looking for is a way or for code that tells you how long it takes a macro to run from start to finish, something that can be used to time any macro. I've seen some threads in the forum where people indicate that it took x amount of seconds for their macro to run but not sure how to do it.

Thank You.
-Ecow

I thought this would be as simple as recording a macro. But when I record, then either right click the data and select Edit Query, or even go up to the main toolbar and select Data, Import External Data, Edit Query...neither records the function.

I have a userform that has a button that gives the user the option to Edit Query. I was hoping to figure out the VB macro to run this option.

Is it possible?

Hello all,

First post here. I have a basic knowledge of using VBA, but haven't had enough experience with it to really do advanced things. What I would ultimately like to do is have a macro that runs from a command button within a spreadsheet that prompts the user to enter in a number (e.g. 823487). From there, I want the macro to search in a specific windows directory for a filename that consists of 823487 and open it up within Adobe Acrobat. This may not even be possible, but this is the ultimate goal.

In the meantime, as I work my way up to it, it would be nice if I could just get the macro to open up the directory in a window and the user for the time being can find the file they need. I'd like to know if anyone can point me in the right direction. I've read a lot about Windows Common Dialog, however when I try to add that control in Excel 2003 I receive an error.

Any response will be greatly appreciated. Thank you.

I have a checklist generator that uses about 20 Checkboxes. The checklist consists of 750 rows of "steps" that should be included or excluded based on the results of all 20 Checkboxes. The individual checkboxes work fine.. but some steps are repeated so IF Checkbox 1 and 3 are checked I am able to resolve to the appropriate steps to complete the task.

I want to be able to check between 1 - 19 checkboxes. Currently I use a formula in a cell to determine which boxes are checked and then "Hide" the appropriate rows to only show the necessary steps to successfuly complete the procedure.

Rows 11 - 31 contain the checkbox logic such as true or false and there is a seperate cell that looks at the checkbox condition and assigns a value like... If Checkbox 1=True then Checkbox value in a seperate cell = 1 and if Checkbox 4 is checked True then the checkbox value in a seperate cell = 4.

I want to be able to sum the total Checkbox values in the seperate cells and if the SUM is 5 then Macro X runs.... and I only want the appropriate macro to run when a command button ="Run Macros" is clicked.

I'm a self taught Excel User so I don't know if there is a better logic secquence Such as Case or Select, etc for this task.. Any help would be appreciated.

Sample for 1 Checkbox.
Private Sub CheckBox6_Click()
If CheckBox6 = True Then
[57:58].EntireRow.Hidden = False
[715:724].EntireRow.Hidden = False
Else: [57:58].EntireRow.Hidden = True
[715:724].EntireRow.Hidden = True
End If
End Sub

I need help creating a macro to copy from a cell in sheet1 to a cell in
sheet1. Though when it pastes I can't have it fill the same cell over
again I need it to paste it in the next cell down from it.

Example:

Sheet1 -> Sheet2

B12 -> B2
D12 -> C2
I5 -> A2
I17 -> E2
G12 -> D2
I22 -> F2
I27 -> G2

I have merged cells from B through G with rows 16-28 needing to be
copied to H2 but become unmerged in the seperate sheet. Can anyone
help me out?

On an excel 2003 workbook, windows xp, I have several text boxes assigned to various macros. I want the macros to run only from the relevant text boxes and no other way.
How can I do this?
Keep in mind that I am a VBA dummie!
Thanks a million in advance.

When I go to Alt-F8 and select and run the UpdateQuotes macro it runs
fine.
I added CommandButton1 with the following simple code:

Private Sub CommandButton1_Click()
Call UpdateQuotes
End Sub

When I click the button I get an error message:

"TextToColumns method of Range Class failed."

and it hangs up on the rngB.TextToColumns Destination:=Range("B2"),
DataType:=xlDelimited.... line.

Why does it run from Alt-F8 but it doesn't run from the command
button?

Thanks for any help.

Nathan

Sub UpdateQuotes()
Dim strSymbols As String
Dim strURLPrefix As String
Dim strURLSuffix As String
Dim strURL As String
Dim rngA As Range
Dim rngB As Range
Dim wsQ As Worksheet
Application.ScreenUpdating = False
Set wsQ = Sheets("Quotes")
Set rngA = Range(Cells(2, 1), Cells(65536, 1).End(xlUp))
wsQ.Activate
wsQ.Range("B2:J200").ClearContents
'On Error GoTo errRunQuery
strURLPrefix = "http://quote.yahoo.com/d/quotes.cvs?s="
strURLSuffix = "&f=sl1d1ohgv&e=.csv"
strSymbols = ConcatSymbols(rngA)
strURL = strURLPrefix & strSymbols & strURLSuffix
With wsQ.QueryTables.Add(Connection:="URL;" & strURL,
Destination:=wsQ.Cells(2, 2))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Set rngB = Range(Cells(2, 2), Cells(65536, 2).End(xlUp))

rngB.TextToColumns Destination:=Range("B2"), DataType:=xlDelimited,
_
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 9),
Array(5, 9), Array(6, 9), _
Array(7, 9))
Columns("B").Select
Selection.Columns.AutoFit
Range("E1").Select
Application.ScreenUpdating = True
Call HangUp
Exit Sub
errRunQuery:

End Sub

I am trying to develop a macro that copies data from one workbook to another,
however looks up the date in wb1, then finds the same date in wb2, and copies
values from wb1 beside the matching date in wb2

e.g. wb1 date 07/07/2007 ,wb2 (monthly report, dates from 1/07 to 31/07/2007
in a column) When macro runs, looks up date in wb1 and then copies data from
wb1 to wb2 if if finds same dte in wb2, otherwise says no data to update,

can anyone help???
Thanks Tiger

I have two workbooks. I want to create a macro that copies information from
one workbook, which will be closed, to another workbook, which will be open.
I would also prefer if this macro could run everytime the second workbook is
opened. Is this possible?

I would appreciate any help,

Adam Bush

I have a customer who wants me to take a scale and send the weight information to an excel sheet along with the date and time of each weight sample. I have connected it and it works great, for testing I made a command click button on an excel sheet that I would click to run the code. The scale sends 14 cells of information to me along with the actual weight being displayed on the screen. My problem is my code works perfect as long as I'm clicking the button to run the code. I worte a code to monitor a cell for changing from "False" to "True" which the scale changes this information when the weight is correct cell D13 will change from False to True. The data is being exchanged via DDE and excel, the weight is enterned in the next empty cell along with the time and date in the next column is the time and date stamp.

Code below
Private Sub CommandButton1_Click()
Dim mycell As Range

Sheets("Sheet1").Select
Range("G13").Select
If [G13].Value = "True" Then
Range("A1").Select
If [A1] > 0.5 Then
'MsgBox (" This Is Working ")

Dim i As Long
Sheet1.Range("A1").Copy
'For i = 20 To 31 Step 1 '12 places for first paste values
Debug.Print i
If IsEmpty(Range("A1").Value) Then
Else
Range("A" & Range("A:A").Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheet1.Range("B1").Copy
Debug.Print f
If IsEmpty(Range("B1").Value) Then
Else
Range("B" & Range("B:B").Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

End If

End If
End If

End Sub

After I wrote the code if the cell value changes to run my code, I tested it by using an empty cell first and just throwing up a message box if the value changes to prompt me with a message. The problem is when the cell value changes via DDE my Macro does not see the change because the enter key hasnt been pressed.
Code below
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$D$13" Then
MsgBox "woohooo" ' above code was inserted here, and it did not work.
End If
End Sub

If I use the above worksheet change and I enter a value on the keyboard and press enter it works. But, they want an operator weighing parts and the macro to run when the correct weight is true, not by someone pressing enter every time. Any one have any thoughts??

I would like the macro to run when the DDE changes cells G13 to True one time and then wait until it goes false and true again before it runs again. I have attaced the sheet I have been working on. Thanks for any help. You can email attachments directly to me at billf@clarkpulley.com
File attachment info
Hardy Test.xls - works perfect as long as G13 = "True" and the Start Slug Recorder is clicked.
Hardy Test 1.xls - This is the file I'm trying to get when the DDE changes cell G13 from "False" to "True" to run the code for "Start Slug Recorder"

Thanks

Hello, I have a workbook that has been emailed to about 300 users that, due to circumstances out of my control, I need to update. What I would like to do is email each user a workbook that contains a macro that will copy four sheets from the original workbook and replace the sheets in the new workbook that are named the same. Due to my very rudimentary coding, I have been unable to overcome some issues buy scabbing together bits and pieces of code gleaned through searching the forum.

Issues:
1. I don't know what the original workbook has been renamed to, so I will need a dialog box to allow the user to select it. From my searches the code below seems to be what I need to use.


2. Both workbooks will contain the exact same named ranges and formats. I believe if the macro will use the pastespecial>Values command it should not affect the named ranges or formats.

3. I would like to rename the new workbook with the exact name of the old workbook and saved in the same location as the original. Then I need to append the old workbook name with "old-do not use". If this is not possible, then deleting the old workbook is fine as well.

4. The workbooks are full of confidential sales information so I cannot post them online. However the sheets that need to be copied and replaced are "Sheet4" through "Sheet7"

5. Ideally, this macro would run the first time the workbook has been opened and not run again. However, if that requires a lot of extra code then I can assign it to a button.

Thank you for any assistance you may provide.

Here are the two files. I am trying to move the sheets listed above from the
file ending with "no sales" to the file ending with "blank"
http://www.4shared.com/file/97107649..._no_sales.html

http://www.4shared.com/file/97108296...testblank.html

Clayton Grove

Updates for clarification are in red.

Hi everyone, hopefully you can help me as I'm a bit of a macro newbie.

I need what I imagine is a fairly simple macro - updating a cell from a list and automatically printing out the tab each time, so pressing one button will update a sheet with each entry in the list and print them all off.

How it's set up:

Cell E5 is the definining cell that my sheet looks up all data from. Cell E5 is a validation list from a range AH6:AH30 (AH6:AH30 can have different number of actual names to put into E5, returning 0 for all the extra spaces down to AH30 if there aren't enough names)

I want to be able to add a big button that I can press that will automatically update E5 to the top name from the list, print the tab, then replace E5 with the next name in the list, print it, replace E5, print it... all the way down until the next name in the list is "0" when it knows to stop.

The possible complication is that I already have a macro in the sheet that looks to see when E5 is changed, and then runs around triggering other smaller macros to update the various part of the sheet. I still need those macros to run each time I update E5 BEFORE I print the sheet.

If Target.Address = "$E$5" Then
   Range("C26").Select
    ActiveCell.FormulaR1C1 = "=R[-16]C"
    Range("C27").Select
    Range("W11:W21").Select
    Selection.ClearContents
    Range("E6").Select
End If

Can anybody help me? Could you write me the macro I need (I don't ask for much, do I?)... and do I need to somehow embed this in the existing macros or will it happily run and allow all the other macros to complete before it hits Print?

Thanks in advance,
Dave

I would like to make a Macro that exports information from one excel file to a master file. I have many files for different jobs that add all of the costs associated with it, and compiles it into 5 different categories. The master file is a listing of each job with the 5 categories listed across. (Each row is a job, and each column is a category)

We have run into problems with people making typos in the transferring from one file to the master, which is why I wanted to make a macro. I took a some classes back in my college days, and at one time I know how to do it (sort of) but that was a few years ago, and now I dont even know where to start.

Any suggestions?

Thanks in advance!

Hi all,

I am very new to Macros in excel, although I can use excel as an application quite well. I am trying to write a macro that I will assign to a button. [two in fact].

I want to autofill the cells in a row, one at a time, each time the button is clicked. I have it working so that it works the first time I click it, but nothing after that.

I have IL001 in cell A1, when I click the "Next" button, it places IL002 into A2 for me no problem, but I want it to place IL003 into A3 on the next click and so forth. I want a similar macro to run to place the current date into C cells when I click another button. Again I can get this to work the first time, but not on susequent clicks. I know I need to make the macro look for the last entry, which I think I have done correctly, but I am struggling on what code comes after this.

Please help, it's driving me mad.

Thanks

Jul

Hello!

I already have code that I believe is supposed to do what I'm trying to accomplish. However, it doesn't fully work. The Macro is below:


	VB:
	
Workbooks.Open Filename:="C:Documents and Settingsplp138DesktopExample 1.xls" 
On Error Resume Next 
With Workbooks("Example 2.xls") 
    LR = .Sheets("Raw Data").Range("A" & Rows.Count).End(xlUp).Row 
    Workbooks("Example 1").Sheets("Data").Range("A1:BT65536").Copy 
    Windows("Example 2.xls").Activate 
    Sheets("Raw Data").Range("A" & LR + 1).PasteSpecial Paste:=xlPasteValues 
    Application.CutCopyMode = False 
End With 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Basically, what I'm trying to accomplish is to have a certain range from one file copied, and pasted in the next available (empty) row of another file. While debugging I see that everything is working except for the actual pasting.

Any advice?

Thank you for your help!

Jace

I'm trying to look at options for scheduling macros to run at a particular time. Ideally I would like to run one at 3:00 am during every week night. From what I've looked into, I can run the OnTime procedure and it could schedule this to run each night. Does anyone know if this is correct, and if there are any other options avaliable to me?

Also, does anyone know if this can run automatically if Excel is closed, or does Excel have to be open? Does the workbook have to be open? Any information you could offer on this would be greatly appreciated. Thanks in advance.

Hello all,

Can someone please help? I am very new to vba but I have managed to write code (multiple subs strung together with Call statements) for about 25 sheets in this one workbook. Each sheet has a command button that initiates the data maipulation that I want to accomplish on that particular sheet. It all works very well when I go to each sheet and click on the command button.

Now I want to make all of these processes run from one command button on the first sheet. All of the subs on every sheet now have unique names because I anticipated wanting to string them all together and run them from one command button. I guess you call this a module for the entire workbook, but I am still struggling with the terminalogy of all this programming, so don't know for sure.

I added the code from the second sheet/command button to the end of the code from the first sheet/command button and joined them with a Call statement. Figured I would go about this sistematically, sheet by sheet. Instantly, I got an error message " Activate method of range class failed" when I ran it. At the start of the added code, I had added something like Worksheets("Sheet2").Activate figuring that I needed to activate that worksheet in order to make the rest of the code work. That is where I got the error.

Sorry for the long winded explanation. Can someone tell me what I need to add/do in order for the code to run without error as I string together all the pieces from each sheet?

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


No luck finding an answer? You could always try Google.