Finding all hyperlinks in row a, copying to new worksheet

Hello I would like to be able to loop through all values in row a, find
all that have a hyperlink present and then copy these values into a new
worksheet.


This is what i have so far:


Sub SameData()
Dim n As Integer, i As Integer
Dim int_Unit As Integer

int_Unit = Sheets("Industry").UsedRange.Rows.Count
n = 1

Do While Not IsEmpty(Sheets("Industry").Cells(n, 1))
For i = 1 To int_Unit
If Sheets("Industry").Cells(n, 1) = ActiveCell.Hyperlinks.Count
Then
Sheets("newsheet").Cells(n, 2) = Sheets("Industry").Cells(i,
1)
End If
Next i
n = n + 1
End Sub

The error i get is 'Do without Loop' could someoen improve this code to
do what i think is essentially a simple code.

thank you

Sub SameData()
Dim hlnk as Hyperlink
Dim n as Long
n = 1
for each hlnk in Sheets("Industry").Hyperlinks
sheets("NewSheet.Cells(n,2).Value = _
hlink.parent.Value
n = n + 1
Next
End sub


--
Regards,
Tom Ogilvy


<[email protected]> wrote in message
news:[email protected]...
> Hello I would like to be able to loop through all values in row a, find
> all that have a hyperlink present and then copy these values into a new
> worksheet.
>
>
> This is what i have so far:
>
>
> Sub SameData()
> Dim n As Integer, i As Integer
> Dim int_Unit As Integer
>
> int_Unit = Sheets("Industry").UsedRange.Rows.Count
> n = 1
>
> Do While Not IsEmpty(Sheets("Industry").Cells(n, 1))
> For i = 1 To int_Unit
> If Sheets("Industry").Cells(n, 1) = ActiveCell.Hyperlinks.Count
> Then
> Sheets("newsheet").Cells(n, 2) = Sheets("Industry").Cells(i,
> 1)
> End If
> Next i
> n = n + 1
> End Sub
>
> The error i get is 'Do without Loop' could someoen improve this code to
> do what i think is essentially a simple code.
>
> thank you
>

Thanks for replying so soon. I noticed a typo in your script
Sheets("newsheet.Cells(n, 2).Value = hlink.Parent.Value
should be
Sheets("newsheet").Cells(n, 2).Value = hlink.Parent.Value

however when i try and run i get Error 'object required'


Sub SameData()
Dim hlnk As Hyperlink
Dim n As Long
n = 1
For Each hlnk In Sheets("Industry").Hyperlinks
Sheets("newsheet").Cells(n, 2).Value = hlink.Parent.Value
n = n + 1
Next
End Sub

So that would be two typos in the same line:

hlink should be hlnk

Sub SameData()
Dim hlnk As Hyperlink
Dim n As Long
n = 1
For Each hlnk In Sheets("Industry").Hyperlinks
Sheets("newsheet").Cells(n, 2).Value = hlnk.Parent.Value
n = n + 1
Next
End Sub


--
Regards,
Tom Ogilvy

<[email protected]> wrote in message
news:[email protected]...
> Thanks for replying so soon. I noticed a typo in your script
> Sheets("newsheet.Cells(n, 2).Value = hlink.Parent.Value
> should be
> Sheets("newsheet").Cells(n, 2).Value = hlink.Parent.Value
>
> however when i try and run i get Error 'object required'
>
>
> Sub SameData()
> Dim hlnk As Hyperlink
> Dim n As Long
> n = 1
> For Each hlnk In Sheets("Industry").Hyperlinks
> Sheets("newsheet").Cells(n, 2).Value = hlink.Parent.Value
> n = n + 1
> Next
> End Sub
>

Thanks, works perfectly.

Another question.. would it be possible to copy to another worksheet
all fields that ARENT hyperlinks? or would the best way be just to
delete the hyplerlinks with
Sheets("Industry").Cells(n,1).Hyperlinks.Delete ?

is that right cheers tom

I guess it depends on what you really want as the end result.

You can do

Sheets("Industry").Hyperlinks.Delete
and this will delete the hyperlinks, but won't delete what is displayed in
the cells (nor will your suggestion).

--
Regards,
Tom Ogilvy

<[email protected]> wrote in message
news:[email protected]...
> Thanks, works perfectly.
>
> Another question.. would it be possible to copy to another worksheet
> all fields that ARENT hyperlinks? or would the best way be just to
> delete the hyplerlinks with
> Sheets("Industry").Cells(n,1).Hyperlinks.Delete ?
>
> is that right cheers tom
>