I am not sure if posting code is a faux pas, but it is a really simple one.
Even though it crashes everytime I run it...Why?
Thanks in advance,
Yo.

Sub explainLocations()
Dim wbL As Workbook, wbT As Workbook
Dim wsT As Worksheet, wsL As Worksheet
Dim rT As Range, rE As Range, rW As Range
Dim rC As Range, rL As Range
Dim swb As String

Set wbL = Workbooks(ActiveWorkbook.Name)
Set wsL = Worksheets(wbL.ActiveSheet.Name)
Set rL = wsL.Range("B1", Range("B1").End(xlToRight).Address(0, 0))

For Each rC In rL.Cells
Set rW = Range(c.Address(0, 0))
swb = "C:\Documents and Settings\Me\Desktop\Web\" & wsL.Name & "\" &
rC.Value
Set wbT = Workbooks.Open(swb)
Set wsT = Worksheets(wbT.ActiveSheet.Name)
Set rT = wsT.Range("A1", Range("B1000").End(xlUp).Address(0, 0))
For Each rE In rT.Cells
If rE.Font.Underline = "2" Then
Set rW = rW.Offset(1, 0)
rW.Value = rE.Value
End If
Next
Set wsT = Nothing
Set rT = Nothing
wbT.Close
Set wbT = Nothing
Next
Set rW = Nothing
End Sub

the only thing I can see wrong
is c is not defined

Set rW = Range(c.Address(0, 0))


should it be Rc

Set rW = Range(Rc.Address(0, 0)

--
Message posted from http://www.ExcelForum.com

It still doesn't work... (You were right about 'c' being 'rC'. For the
post, I tried to change all the 'c' to 'rC' to make it easier to read.) I
have tried this sub on multiple computers with multiple Exel versions.
Everyone of them eternally hangs.


"mudraker " wrote in message
...
the only thing I can see wrong
is c is not defined

Set rW = Range(c.Address(0, 0))


should it be Rc

Set rW = Range(Rc.Address(0, 0))


---
Message posted from http://www.ExcelForum.com/

to top of module, add Option Explicit and then compile

Error= Set rW = Range(c.Address(0, 0))
c is not defined

If it is meant to be rC then try this re-write

Sub explainLocations()
Dim wbL As Workbook, wbT As Workbook
Dim wsT As Worksheet, wsL As Worksheet
Dim rT As Range, rE As Range, rW As Range
Dim rC As Range, rL As Range
Dim swb As String

Set wbL = ActiveWorkbook
Set wsL = wbL.ActiveSheet
Set rL = wsL.Range("B1", wsL.Range("B1").End
(xlToRight).Address(0, 0))

For Each rC In rL
swb = "C:\Documents and Settings\Me\Desktop\Web\" &
wsL.Name & "\" & rC.Value
Set wbT = Workbooks.Open(swb)
Set wsT = wbT.ActiveSheet
Set rT = wsT.Range("A1", wsT.Range("B1000").End
(xlUp).Address(0, 0))
'fairly pointless because multiple occurrences will
mean the cell gets overwritten
For Each rE In rT
If rE.Font.Underline = xlUnderlineStyleSingle Then
rC.Offset(1, 0).Value = rE.Value
End If
Next
Set rT = Nothing
Set wsT = Nothing
'possible error here
wbT.Close
Set wbT = Nothing
Next
End Sub

Kevin Beckham

-----Original Message-----
I am not sure if posting code is a faux pas, but it is a
really simple one.
Even though it crashes everytime I run it...Why?
Thanks in advance,
Yo.

Sub explainLocations()
Dim wbL As Workbook, wbT As Workbook
Dim wsT As Worksheet, wsL As Worksheet
Dim rT As Range, rE As Range, rW As Range
Dim rC As Range, rL As Range
Dim swb As String

Set wbL = Workbooks(ActiveWorkbook.Name)
Set wsL = Worksheets(wbL.ActiveSheet.Name)
Set rL = wsL.Range("B1", Range("B1").End
(xlToRight).Address(0, 0))

For Each rC In rL.Cells
Set rW = Range(c.Address(0, 0))
swb = "C:\Documents and Settings\Me\Desktop\Web\" &
wsL.Name & "\" &
rC.Value
Set wbT = Workbooks.Open(swb)
Set wsT = Worksheets(wbT.ActiveSheet.Name)
Set rT = wsT.Range("A1", Range("B1000").End
(xlUp).Address(0, 0))
For Each rE In rT.Cells
If rE.Font.Underline = "2" Then
Set rW = rW.Offset(1, 0)
rW.Value = rE.Value
End If
Next
Set wsT = Nothing
Set rT = Nothing
wbT.Close
Set wbT = Nothing
Next
Set rW = Nothing
End Sub


.