Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations sizbut on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

EXCEL VBA: Look for Dynamic Hyperlink

Status
Not open for further replies.
JAMES717

JAMES717

Technical User
Oct 13, 2009
15
US
I have a static list of numbers (Vendor ID) and the job cycles through each number and opens a file (if present).

The problem is that the On Error only works the first time through the job. I can not use On Error Resume Next, because I have lines of code that if the file opens that need to be completed.

I can not use “if DIR(myfile) = “” then” because I am trying to lookup a file on the internet and DIR(“ & ActiveCell & “.xls”) is not working.

Sample CODE (as is):

Do Until ActiveCell = ""

On Error GoTo errhndler:

Workbooks.Open FileName:=" & ActiveCell.Offset(0, 1) & " " & ActiveCell & ".xls
 
Sort by date Sort by votes
When you open the file containing the macro, the collection, Workbooks, contains only 1 element. When you have successfully opened another workbook, the Workbooks collection will have 2 elements (i.e., Workbooks.count=2). Can you use the size of the Workbooks collection to know if you should continue or not?

_________________
Bob Rashkin
 
Upvote 0 Downvote
Hi,

I advise against using ActiveWhatever...
Code: 
Dim r as range

On error resume next

for each r in range([A2], [A2].end(xldown))  ' assuming that A2 is the first cell in the column range - MODIFY TO SUIT
  Workbooks.Open FileName:="[URL unfurl="true"]http://sharepoint/SC/procure/scorecard/Combined%20Scorecards/"[/URL] & ActiveCell.Offset(0, 1) & " " & r.value & ".xls"

if err.number = 0 then
  'now do yer thing with the open workbook

else
  ' TILT! no workbook! so what do you have to do here?
  err.clear
end if

next


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
When the Do until starts for the second time, I get error 1004.

All code:

Application.DisplayAlerts = False

Workbooks.Open FileName:=" Columns("A:B").Copy
Workbooks.Add
ActiveSheet.Paste
Sheets(2).Delete
Sheets(2).Delete

ActiveWorkbook.SaveAs FileName:="T:\Table.xls"
ActiveSheet.Name = "Table"
Windows("Master List.xls").Close
Range("A2").Select

Do Until ActiveCell = ""

On Error GoTo Quality: Workbooks.Open FileName:=" & ActiveCell.Offset(0, 1) & " " & ActiveCell & ".xls"
ActiveWorkbook.SaveAs FileName:="H:\Projects\KPI Scorecard\ASN.xls"
ActiveSheet.Copy After:=Workbooks("Table.xls").Sheets(1)
Windows("ASN.xls").Activate
ActiveWindow.Close
Kill "H:\Projects\KPI Scorecard\ASN.xls"
ActiveSheet.Name = "ASN"
Sheets("Table").Select


Quality:

On Error GoTo SRM: Workbooks.Open FileName:=" & ActiveCell.Offset(0, 1) & " " & ActiveCell & ".xls"

ActiveWorkbook.SaveAs FileName:="H:\Projects\KPI Scorecard\Quality.xls"
ActiveSheet.Copy After:=Workbooks("Table.xls").Sheets(1)
Windows("Quality.xls").Activate
ActiveWindow.Close
Kill "H:\Projects\KPI Scorecard\Quality.xls"
ActiveSheet.Name = "Quality"
Sheets("Table").Select

SRM:

On Error GoTo COMBINE: Workbooks.Open FileName:=" & ActiveCell.Offset(0, 1) & " " & ActiveCell & ".xls"

ActiveWorkbook.SaveAs FileName:="H:\Projects\KPI Scorecard\SRM.xls"
ActiveSheet.Copy After:=Workbooks("Table.xls").Sheets(1)
Windows("SRM.xls").Activate
ActiveWindow.Close
Kill "H:\Projects\KPI Scorecard\SRM.xls"
ActiveSheet.Name = "SRM"

COMBINE:

If Sheets.Count = 1 Then
ActiveCell.Offset(1, 0).Select
Else

ActiveWorkbook.SaveAs FileName:= _
"H:\Projects\KPI Scorecard\Group Scorecard\Test.xls"

Sheets(1).Select
Sheets(1).Move

ActiveWorkbook.SaveAs FileName:= _
"T:\Table.xls"

Windows("Test.xls").Activate

If ActiveSheet.Name = "SRM" Then
ActiveWorkbook.SaveAs FileName:= _
" & Range("A4") & " " & Range("F4") & ".xls"
End If

If ActiveSheet.Name = "Quality" Then
ActiveWorkbook.SaveAs FileName:= _
" & Range("A4") & " " & Range("K4") & ".xls"
End If

If ActiveSheet.Name = "ASN" Then
ActiveWorkbook.SaveAs FileName:= _
" & Range("A4") & " " & Range("I4") & ".xls"
End If

ActiveWindow.Close
Kill "H:\Projects\KPI Scorecard\Group Scorecard\Test.xls"

ActiveCell.Offset(1, 0).Select
End If

Loop

Kill "T:\Table.xls"

ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub
 
Upvote 0 Downvote



Please explain (without code) what your PROCESS is and what you are trying to do.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
What I am trying to do:

I am opening a list on a sharepoint site to get an ever changing list of vendor ID's.

I am copying this information and putting into a new workbook.

I go to each vendor ID, and look for a certain file on a sharepoint site that contains the ID.

I then take each of the different files and combine into one workbook and save on a sharepoint site.

Problem:

Everything works fine on the first pass of the loop. When the process starts over, the onError statements do not function properly.
 
Upvote 0 Downvote



You are not using the On Error code correctly.

Did you try my approch?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
SkipVought,

I redid everything and it did not function properly. So I took out the on error resume next to find the bug.

on the line of code For Each r In Range([A2], [A2].End(xlDown)) I am getting error 424
 
Upvote 0 Downvote



this basic code control structure will run in any module...
Code: 
Sub test()
    Dim r As Range

    On Error Resume Next
    
    For Each r In Range([A2], [A2].End(xlDown))
    
        If Err.Number = 0 Then
        
        Else
          
          Err.Clear
        End If
    
    Next
End Sub

Please copy and paste the exact code that you are currently using.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Exact Code in current Sub()

Sub COMBINE()
'
' COMBINE Macro
' Macro recorded by NACCO
'

'
Application.DisplayAlerts = False

Dim r As Range

Workbooks.Open FileName:=" Columns("A:B").Copy
Workbooks.Add
ActiveSheet.Paste
Sheets(2).Delete
Sheets(2).Delete

ActiveWorkbook.SaveAs FileName:="T:\Table.xls"
ActiveSheet.Name = "Table"
Windows("Master List.xls").Close
Range("A2").Select

'On Error Resume Next

For Each r In Range([A2], [A2].End(xlDown))

Workbooks.Open FileName:=" & ActiveCell.Offset(0, 1) & " " & r.Value & ".xls"

If Err.Number = 0 Then
ActiveWorkbook.SaveAs FileName:="H:\Projects\KPI Scorecard\ASN.xls"
ActiveSheet.Copy After:=Workbooks("Table.xls").Sheets(1)
Windows("ASN.xls").Activate
ActiveWindow.Close
Kill "H:\Projects\KPI Scorecard\ASN.xls"
ActiveSheet.Name = "ASN"
Sheets("Table").Select
Else
Err.Clear
End If

Workbooks.Open FileName:=" & ActiveCell.Offset(0, 1) & " " & r.Value & ".xls"

If Err.Number = 0 Then
ActiveWorkbook.SaveAs FileName:="H:\Projects\KPI Scorecard\Quality.xls"
ActiveSheet.Copy After:=Workbooks("Table.xls").Sheets(1)
Windows("Quality.xls").Activate
ActiveWindow.Close
Kill "H:\Projects\KPI Scorecard\Quality.xls"
ActiveSheet.Name = "Quality"
Sheets("Table").Select
Else
Err.Clear
End If


Workbooks.Open FileName:=" & ActiveCell.Offset(0, 1) & " " & r.Value & ".xls"

If Err.Number = 0 Then
ActiveWorkbook.SaveAs FileName:="H:\Projects\KPI Scorecard\SRM.xls"
ActiveSheet.Copy After:=Workbooks("Table.xls").Sheets(1)
Windows("SRM.xls").Activate
ActiveWindow.Close
Kill "H:\Projects\KPI Scorecard\SRM.xls"
ActiveSheet.Name = "SRM"

Else
Err.Clear
End If

If Sheets.Count = 1 Then
ActiveCell.Offset(1, 0).Select
Else

ActiveWorkbook.SaveAs FileName:= _
"H:\Projects\KPI Scorecard\Group Scorecard\Test.xls"

Sheets(1).Select
Sheets(1).Move

ActiveWorkbook.SaveAs FileName:= _
"T:\Table.xls"

Windows("Test.xls").Activate

If ActiveSheet.Name = "SRM" Then
ActiveWorkbook.SaveAs FileName:= _
" & Range("A4") & " " & Range("F4") & ".xls"
End If

If ActiveSheet.Name = "Quality" Then
ActiveWorkbook.SaveAs FileName:= _
" & Range("A4") & " " & Range("K4") & ".xls"
End If

If ActiveSheet.Name = "ASN" Then
ActiveWorkbook.SaveAs FileName:= _
" & Range("A4") & " " & Range("I4") & ".xls"
End If

ActiveWindow.Close
Kill "H:\Projects\KPI Scorecard\Group Scorecard\Test.xls"

ActiveCell.Offset(1, 0).Select
End If

Next

Kill "T:\Table.xls"

ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub
 
Upvote 0 Downvote



OK.

1. you have ThisWorkbook -- the workbook that the VBA code is in.

2. you have a workbook that you are opening.

3. you have a workbook that you ADD and paste into

So, where is the LIST that you are looping thru??? This is the issue.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
The original workbook (Master List) I copy Columns A:B and paste into a new workbook (Table); closing the original workbook.

The new workbook contains the list.
 
Upvote 0 Downvote



and is each Vendor in your list opening THREE workbooks?

On-time Shipment
Quality Reports
SRM Compliance


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
If present, yes.

I need it to open the reports that are availble for each vendor. if none available, go to next vendor.
 
Upvote 0 Downvote
"The new workbook contains the list. "

You really have too much implied references. You really ought to explicitly reference each object.
Code: 
dim r as range, wsMaster as worksheet, wsNew as worksheet, ws as worksheet

set wsmaster =  Workbooks.Open( FileName:="[URL unfurl="true"]http://amersharepoint/SupplyChainManagement/amerprocure/combined_scorecards/Master%20Data/Master%20List.xls").Sheets("TheSheetYOU_WantToWorkOn")[/URL]
    wsMaster.Columns("A:B").Copy
    set wsNew = Workbooks.Add
    wsNew.ActiveSheet.Paste
    wsNew.Sheets(2).Delete
    wsNew.Sheets(2).Delete
''etcetera.


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Skip,

In looking at the code that you supplied (thanks) it looks like this is simplifying the beginning part of my code. The beginning part current functions properly, even though poorly designed.

Do you think that if I edit the beginning part it will resolve the other issue?
 
Upvote 0 Downvote
Here's hwo it would look. You can complete the last two...
Code: 
Dim r As Range, sPath As String, wsNew As Worksheet, ws As Worksheet

    sPath = "[URL unfurl="true"]http://amersharepoint/SupplyChainManagement/amerprocure/combined_scorecards/Combined%20Scorecards/"[/URL]

    With Workbooks.Open(Filename:="[URL unfurl="true"]http://amersharepoint/SupplyChainManagement/amerprocure/combined_scorecards/Master%20Data/Master%20List.xls")[/URL]
        .Columns("A:B").Copy
        Set wsNew = Workbooks.Add.Sheets(1)
        With wsNew
            .Paste
            .Sheet2(2).Delete
            .Sheet2(2).Delete
            .Parent.SaveAs Filename:="T:\Table.xls"
            .Name = "Table"
        End With
        .Close
    End With


'On Error Resume Next

For Each r In Range(wsNew.[A2], wsNew.[A2].End(xlDown))

    Set ws = Workbooks.Open( _
        Filename:=sPath & "On-time%20Shipment/" & r.Offset(0, 1) & " " & r.Value & ".xls")
        
        If Err.Number = 0 Then
                ws.Parent.SaveAs Filename:="H:\Projects\KPI Scorecard\ASN.xls"
                ws.Copy After:=wsNew.Parent.Sheets(1)
                ws.Close
                wsNew.Parent.Sheets(1).Name = "ASN"
        Else
            Err.Clear
        End If

    Set ws = Workbooks.Open( _
        Filename:=sPath & "Quality%20Reports/" & r.Offset(0, 1) & " " & r.Value & ".xls")
'.....

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Here's hwo it would look. You can complete the last two...
Code: 
Dim r As Range, sPath As String, wsNew As Worksheet, ws As Worksheet

    sPath = "[URL unfurl="true"]http://amersharepoint/SupplyChainManagement/amerprocure/combined_scorecards/Combined%20Scorecards/"[/URL]

    With Workbooks.Open(Filename:="[URL unfurl="true"]http://amersharepoint/SupplyChainManagement/amerprocure/combined_scorecards/Master%20Data/Master%20List.xls")[/URL]
        .Columns("A:B").Copy
        Set wsNew = Workbooks.Add.Sheets(1)
        With wsNew
            .Paste
            .Sheet2(2).Delete
            .Sheet2(2).Delete
            .Parent.SaveAs Filename:="T:\Table.xls"
            .Name = "Table"
        End With
        .Close
    End With


'On Error Resume Next

For Each r In Range(wsNew.[A2], wsNew.[A2].End(xlDown))

    Set ws = Workbooks.Open( _
        Filename:=sPath & "On-time%20Shipment/" & r.Offset(0, 1) & " " & r.Value & ".xls")
        
        If Err.Number = 0 Then
                ws.Parent.SaveAs Filename:="H:\Projects\KPI Scorecard\ASN.xls"
                ws.Copy After:=wsNew.Parent.Sheets(1)
                ws.Parent.Close
                wsNew.Parent.Sheets(1).Name = "ASN"
        Else
            Err.Clear
        End If

    Set ws = Workbooks.Open( _
        Filename:=sPath & "Quality%20Reports/" & r.Offset(0, 1) & " " & r.Value & ".xls")
'.....

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
on .Sheet2(2).Delete

I am getting a Compile Error: Method or data member not found.

on Set ws = Workbooks.Open( _
FileName:=sPath & "On-time%20Shipment/" & r.Offset(0, 1) & " " & r.Value & ".xls")

It opens the file, but I am getting a Type mismatch error
 
Upvote 0 Downvote



sorry. It is the workbook (parent of the worksheet) that is saved...
Code: 
        Set wsNew = Workbooks.Add.Sheets(1)
        With wsNew
            .Paste
            .Parent.Sheet2(2).Delete
            .Parent.Sheet2(2).Delete
            .Parent.SaveAs Filename:="T:\Table.xls"
            .Name = "Table"
        End With

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Question
Run PowerShell Commands from Excel VBA
Replies
14
Views
3K
dhookom
dhookom
thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
505
combo
combo
Andrzejek
  • Locked
  • Question
Outlook VBA - Trust access
Replies
3
Views
803
hermanlaksko
hermanlaksko
remeng
  • Locked
  • Question
Getting results from a dynamic dimension array
Replies
2
Views
542
Andrzejek
Andrzejek
SLW89
  • Locked
  • Question
VBA newbie needs help
Replies
4
Views
445
Andrzejek
Andrzejek

Part and Inventory Search

Sponsor

Back
Top