Macro add Hyperlink formula

Z

zak

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
 
D

Dave Peterson

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
 
Z

zak

Hi Dave

No - the "Appointments" sheet is not relating to me query, I'm still talking
about the Toshiba and dell sheets. I'll give the code a try now. Thanks
again.
 
Z

zak

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
 
D

Dave Peterson

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
 
Z

zak

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.SpecialCells(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
 
D

Dave Peterson

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!
 
Top