epd
03-28-2012, 03:16 PM
Hi,
what i am trying to do:
*i have about 2000 rows.
*start from first row
*for each row that contains .pdf in one cell, i want another cell in that row to equal .dir
*hyperlink cell if cell contains dir
*move onto next cell (for all approx 2000 cells)
the problem:
*it is hyperlinking every cell even if the other cell doesn't contain .pdf.
*i think it is looking at the first row and if the cell has .pdf it applies it too all cells
what i want to do:
*select entire row of first row (21)
*if col 21 = .pdf then col 23 = .dir
*of col 23 = dir hyperlink .dir to fname value
*move onto next row (22)....do the same....and so on and so on all the way to row 2039
the code i am using:
Private Sub UserForm_activate()
'Unprotect Workbook
ThisWorkbook.Worksheets("Cover Page").Unprotect Password:="password"
ThisWorkbook.Worksheets("D - Documentation").Unprotect Password:="password"
ThisWorkbook.Worksheets("E - Electrical").Unprotect Password:="password"
ThisWorkbook.Worksheets("F - Process Flow & P&ID").Unprotect Password:="password"
ThisWorkbook.Worksheets("G - General Arrangement").Unprotect Password:="password"
ThisWorkbook.Worksheets("L - Layout").Unprotect Password:="password"
'Open Userform on same screen as workbook and center
With UserForm1
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
End With
'DIR HYPERLINKING
Me.Repaint
'select cells and clear values
ActiveSheet.Range("W21:W2039").Select
Selection.ClearContents
'Run Hyperlinking
For Each cll In Range("W21:W2039").Cells
fname = "I:\Drafting\As Built\4CP - Pinkenba\E - Electrical\Zircon Plant\"
shortname = ".dir"
Selection.EntireRow.Select
If CStr(Selection("21").Value) = ".pdf" Then
Selection("23").Value = ".dir"
Else
Selection("23").Value = "-"
End If
If CStr(Selection("23").Value) = ".dir" Then
cll.Parent.Hyperlinks.Add cll, fname, , , shortname
Else
cll.Value = "-"
End If
Next cll
'Close UserForm1
Unload UserForm1
End Sub
also posted here (http://www.mrexcel.com/forum/showthread.php?p=3098465#post3098465)
thankyou
what i am trying to do:
*i have about 2000 rows.
*start from first row
*for each row that contains .pdf in one cell, i want another cell in that row to equal .dir
*hyperlink cell if cell contains dir
*move onto next cell (for all approx 2000 cells)
the problem:
*it is hyperlinking every cell even if the other cell doesn't contain .pdf.
*i think it is looking at the first row and if the cell has .pdf it applies it too all cells
what i want to do:
*select entire row of first row (21)
*if col 21 = .pdf then col 23 = .dir
*of col 23 = dir hyperlink .dir to fname value
*move onto next row (22)....do the same....and so on and so on all the way to row 2039
the code i am using:
Private Sub UserForm_activate()
'Unprotect Workbook
ThisWorkbook.Worksheets("Cover Page").Unprotect Password:="password"
ThisWorkbook.Worksheets("D - Documentation").Unprotect Password:="password"
ThisWorkbook.Worksheets("E - Electrical").Unprotect Password:="password"
ThisWorkbook.Worksheets("F - Process Flow & P&ID").Unprotect Password:="password"
ThisWorkbook.Worksheets("G - General Arrangement").Unprotect Password:="password"
ThisWorkbook.Worksheets("L - Layout").Unprotect Password:="password"
'Open Userform on same screen as workbook and center
With UserForm1
.StartUpPosition = 0
.Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
.Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
End With
'DIR HYPERLINKING
Me.Repaint
'select cells and clear values
ActiveSheet.Range("W21:W2039").Select
Selection.ClearContents
'Run Hyperlinking
For Each cll In Range("W21:W2039").Cells
fname = "I:\Drafting\As Built\4CP - Pinkenba\E - Electrical\Zircon Plant\"
shortname = ".dir"
Selection.EntireRow.Select
If CStr(Selection("21").Value) = ".pdf" Then
Selection("23").Value = ".dir"
Else
Selection("23").Value = "-"
End If
If CStr(Selection("23").Value) = ".dir" Then
cll.Parent.Hyperlinks.Add cll, fname, , , shortname
Else
cll.Value = "-"
End If
Next cll
'Close UserForm1
Unload UserForm1
End Sub
also posted here (http://www.mrexcel.com/forum/showthread.php?p=3098465#post3098465)
thankyou