LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #23   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default Macro add Hyperlink formula

If you're going to stay in excel, you'll have to open excel and the workbook.
If you don't want to click the button, you could use the Auto_Open or
workbook_open procedures that run when the workbook is opened.

And if you don't want to even open excel and the workbook, maybe you could use a
scheduling program (some versions of windows have their own, but you can find
others on google).

And if you haven't looked at Ron de Bruin's site, it may come in handy someday):
http://www.rondebruin.nl/tips.htm

Good luck!

zak wrote:

Thanks Dave

Your code works perfectly. Thank you for all your help.

Now - This is my last question for now, i promise, do you know anything
about sendin automatic e-mail where I won't have to even create a button to
send the e-mail, nor open the workbook up - i want it to be totally auto
generated. I have code that works fine, but i have to press a button in
order for it to work. But I want something, where its completely auto
generated.

It's OK if you can't help, Im grateful for all your help thus far. But if
you think you can help, then please see my code below, which runs from
pressing a button:

Thanks in advance:

Sub TestFile_2()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

On Error GoTo cleanup
For Each cell In
Sheets("RSReleaseDates").Columns("B").Cells.Specia lCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) =
"yes" _
And LCase(cell.Offset(0, 2).Value) < "Sent" Then
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Reminder - New RhymeSIGHT Release Coming Soon"
.Body = "Dear " & cell.Offset(0, -1).Value & vbNewLine &
vbNewLine & _
"A new version of RhymeSIGHT is due to be released 7
days from receipt of this e-mail." & vbNewLine & vbNewLine & _
"Please e-mail me to arrange a date to upgrade your
laptop." & vbNewLine & vbNewLine & _
"Thank You." & vbNewLine & vbNewLine & _
"(YOUR NAME)" & vbNewLine & vbNewLine & _
"On Behalf of Support Services"
.Display 'or use Send
End With
On Error GoTo 0

cell.Offset(0, 2).Value = "Sent"
Set OutMail = Nothing
End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

"Dave Peterson" wrote:

Maybe...


Option Explicit
Sub PasteTosh2()

Dim FromWks As Worksheet
Dim FirstRow As Long
Dim ToWks As Worksheet
Dim FromRow As Long
Dim DestCell As Range

Set FromWks = Worksheets("Toshiba (00226)")
Set ToWks = Worksheets("toshiba_history")

With ToWks
'assumes that column A is always used!
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

With FromWks
FirstRow = 2 'headers in row 1???
For FromRow = .Cells(.Rows.Count, "K").Row To FirstRow Step -1
If LCase(.Cells(FromRow, "K").Value) = LCase("Complete") Then
'copy 11 columns to the destination cell
.Cells(FromRow, "A").Resize(1, 11).Copy _
Destination:=DestCell
'delete that entire row
.Rows(FromRow).Delete
'get ready for the next one (move down a row)
Set DestCell = DestCell.Offset(1, 0)
End If
Next FromRow
End With
End Sub

(Untested, but it did compile.)

You may want to look at Ron de Bruin's EasyFilter addin:
http://www.rondebruin.nl/easyfilter.htm

If you ever have more options and each option gets its own worksheet



zak wrote:

Hi Dave

The code you have given me below works a treat, as I wanted. So, THANK YOU
VERY MUCH! I adapted your code to help me in other areas of my spreadsheet
system which I had similar issues that new rows were not being added, so
thanks again for all your help.

There was something else, I had posted another issue on here, which i did
get a response for, but I had to e-mail the person again and have had no
reply in a few days because I needed further help. So, if you can help me
with this too, it will be greatly appreciated, hopefully I can meet my
deadline too:

When the Toshiba (00226) sheet gets populated from info entered into the
form, I've added a new column,K, which the heading is "Complete?". Then in
column K i have created a list drop down (via Data - Validation - Allow:List
etc) with two options (1. Complete or 2. Pending). My intention is that when
Complete is selected from the drop down for a particular row, I'd like the
row from A:K to be cut and pasted into the Toshiba_History sheet from row 2
onwards, as row 1 contains headings). Then once pasted, that row in Toshiba
(00226) should get deleted.

After this, any new rows in Toshiba (00226) that have complete in row K
should get pasted in a new row in Toshiba_History (so it's the adding the
info to a new row again).

Please let me know if you can help. The person helping me before has not
responded and my deadline has been set by my manager for this Friday.

Here is my code that I have, but it doesn't work as I wanted i.e. it copies
the whole row when I just want it to cut the row from column A to K, and once
copied, the info on Toshiba (00226) does not get deleted.

Sub PasteTosh()
'Sheet3 .....all data..(Toshiba (00226))
'Sheet6......contains filtered data_(Toshiba_History)
Dim i, j, n As Integer
j = 1
Sheet3.Activate
For i = 1 To Sheet3.UsedRange.Rows.Count
If (Cells(i, 11) = "Complete") Then
For n = 1 To Sheet3.UsedRange.Columns.Count
Sheet6.Cells(j, n) = Sheet3.Cells(i, n)
Next n
j = j + 1
End If
Next i
End Sub

"Dave Peterson" wrote:

I'm confused.

Do you want to write the values to a worksheet named "Appointments",
"Toshiba (00226)", or "Dell (B000234)"?

I'm guessing that Appointments doesn't matter anymore.

Option Explicit
Private Sub BtnSaveInfo_Click()

Dim Sht As Worksheet
Dim myFileName As Variant
Dim NextRow As Long
Dim myFormula As String

myFileName = Application.GetOpenFilename(filefilter:="All Files, *.*")
If myFileName = False Then
Beep 'do nothing???
myFormula = ""
Else
myFormula _
= "=hyperlink(""file:////""&" _
& """" & myFileName & """)"

Me.DocFilePath.Value = myFileName
End If

If Laptop1.Value = True Then
Set Sht = ThisWorkbook.Worksheets("Toshiba (00226)")
Else
Set Sht = ThisWorkbook.Worksheets("Dell (B000234)")
End If

With Sht
'what column can be used for the nextrow
'change "I" to the column letter that you know always has
'data when the row is used.
NextRow = .Cells(.Rows.Count, "I").End(xlUp).Row + 1
Sht.Cells(NextRow, "A").Value = TextBox2.Text
Sht.Cells(NextRow, "B").Value = RecDate.Text
Sht.Cells(NextRow, "C").Value = RSVers.Text
Sht.Cells(NextRow, "D").Value = CachVers.Text
Sht.Cells(NextRow, "E").Value = ApacVers.Text
Sht.Cells(NextRow, "F").Value = TomcVers.Text
Sht.Cells(NextRow, "G").Value = JavVers.Text
Sht.Cells(NextRow, "H").Value = TextBox1.Text
Sht.Cells(NextRow, "J").Value = mailworkdone1.Text
Sht.Cells(NextRow, "I").Formula = myFormula
End With
End Sub


zak wrote:

Dave

Thank you for being ever so kind and helping me out with this. It works
perfectly.

Everytime you respond to me, I always want to take the code further and make
it more dynamic.

You know how everytime the form is being filled in and I've hard coded it in
so that it all gets written to A2, B2, C2 and so on.... well I want to add
the new info to the next available row each time the form is filled in.

Here is my code, Please Dave let me know if you can help. Ive tried that
code where you do:

If Sheets("Appointments").Range("A2").Value = "" _
Then
R = 2
Else
R = Sheets("Appointments").Range("A1").End(xlDown).Row + 1
End If

Bur it doesnt work, I dont know how to fit it into the current code, which
is below:

Private Sub BtnSaveInfo_Click()
Dim Sht As Worksheet

Dim myFileName As Variant
Dim NextRow As Long
Dim myFormula As String

myFileName = Application.GetOpenFilename(filefilter:="All Files, *.*")
If myFileName = False Then
Beep 'do nothing???
myFormula = ""
Else
myFormula _
= "=hyperlink(""file:////""&" _
& """" & myFileName & """)"
'Me.DocFilePath.Value = myFileName
End If

If Laptop1.Value = True Then
Set Sht = ThisWorkbook.Worksheets("Toshiba (00226)")
Else
Set Sht = ThisWorkbook.Worksheets("Dell (B000234)")
End If

With Sht
Sht.Range("A2").Value = TextBox2.Text
Sht.Range("B2").Value = RecDate.Text
Sht.Range("C2").Value = RSVers.Text
Sht.Range("D2").Value = CachVers.Text
Sht.Range("E2").Value = ApacVers.Text
Sht.Range("F2").Value = TomcVers.Text
Sht.Range("G2").Value = JavVers.Text
Sht.Range("H2").Value = TextBox1.Text
Sht.Range("J2").Value = mailworkdone1.Text
Sht.Range("I2").Formula = myFormula

End With
WorkCompleted.Hide
End Sub

"Dave Peterson" wrote:

In I4 of either sheet--or the next row in either sheet?



Private Sub BtnSaveInfo_Click()
Dim Sht As Worksheet

Dim myFileName As Variant
Dim NextRow As Long
dim myFormula as string

myFileName = Application.GetOpenFilename(filefilter:="All Files, *.*")
If myFileName = False Then
Beep 'do nothing???
myformula = ""
Else
myformula _
= "=hyperlink(""file:////""&" _
& """" & myFileName & """)"
Me.DocFilePath.Value = myFileName
End If

If Laptop1.Value = True Then
Set Sht = ThisWorkbook.Worksheets("Toshiba (00226)")
else
Set Sht = ThisWorkbook.Worksheets("Dell (B000234)")
end if

with Sht
Sht.Range("A4").Value = TextBox2.Text
Sht.Range("B4").Value = RecDate.Text
Sht.Range("C4").Value = RSVers.Text
Sht.Range("D4").Value = CachVers.Text
Sht.Range("E4").Value = ApacVers.Text
Sht.Range("F4").Value = TomcVers.Text
Sht.Range("G4").Value = JavVers.Text
Sht.Range("H4").Value = TextBox1.Text
Sht.Range("J4").Value = mailworkdone1.Text

'not sure which one should be used
NextRow = .Cells(.Rows.Count, "I").End(xlUp).Row + 1
sht.Cells(NextRow, "I").Formula = myFormula
'or
'sht.range("I4").formula = myformula

end with
End Sub

Uncompiled, untested.

If you only have two option buttons, you can probably check one and decide what
to. And since the cells getting the value are the same addresses, you can just
use that "with sht" after deciding which sheet to use.



zak wrote:

Hi Dave

Thanks for giving the code in your last response. It work as I wanted.
There is something else Id like to ask you in connection with this....

The form in which the browse buttons sits has other information which needs
to be entered. There are 2 radion buttons called radiobutton1 and
radiobutton2, depending on which button is selected the information is copied
into the respective sheet (laptop1 or laptop2). Below is the code for this
condition:

Private Sub BtnSaveInfo_Click()
Dim Sht As Worksheet

If Laptop1.Value = True Then
Set Sht = ThisWorkbook.Worksheets("Toshiba (00226)")
Sht.Range("A4").Value = TextBox2.Text
Sht.Range("B4").Value = RecDate.Text
Sht.Range("C4").Value = RSVers.Text
Sht.Range("D4").Value = CachVers.Text
Sht.Range("E4").Value = ApacVers.Text
Sht.Range("F4").Value = TomcVers.Text
Sht.Range("G4").Value = JavVers.Text


--

Dave Peterson
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro in Hyperlink adeel via OfficeKB.com Excel Discussion (Misc queries) 1 July 3rd 09 08:31 PM
Hyperlink to a Macro pokdbz Excel Discussion (Misc queries) 4 October 4th 07 08:18 PM
Hyperlink Macro Diane Excel Discussion (Misc queries) 0 September 25th 06 04:51 PM
Intra-workbook hyperlink: macro/function to return to hyperlink ce marika1981 Excel Discussion (Misc queries) 3 May 6th 05 05:47 AM
Macro to Copy Hyperlink to another file as a HYPERLINK, not text... dollardoc Excel Programming 1 April 7th 05 12:47 AM


All times are GMT +1. The time now is 10:50 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"