Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 561
  • Last Modified:

why does this Excel VBA code just exit without proceeding?

it just exits/stops after this, without any error message, after opening the SourceWb

Set SourceWb = Workbooks.Open("C:\!ee\AgreementBase\ee_company_details_BANANA.xls")


Sub FetchDataFromIndividualFilesToDb()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.AutomationSecurity = msoAutomationSecurityForceDisable

'dim the variables
Dim ActiveCompany As String, ActiveCompanyRowInDb As Integer, LastRowAgreementDb As Integer, ActiveCompanyRow As Integer, LastColTargetWs As Integer

'dim the ranges
Dim TargetRange As Range, SourceRange As Range, SortRange As Range, SourceCompanyCodeRange As Range, TargetCompanyCodeRange As Range

'dim the workbooks
Dim TargetWb As Workbook, SourceWb As Workbook

'dim the worksheets
Dim TargetWs As Worksheet, SourceWs As Worksheet

'set and open workbooks
Set TargetWb = ActiveWorkbook
Set SourceWb = Workbooks.Open("C:\!ee\AgreementBase\ee_company_details_BANANA.xls")
'Set TargetWb = Workbooks("ee_agreement_base.xls")


'set worksheets
Set TargetWs = TargetWb.Sheets("AgreementData")
Set SourceWs = SourceWb.Sheets("CompanyData")

'activate SourceWb
SourceWb.Activate

'get Company Code to process
ActiveCompany = SourceWs.Range("B41").Value
If ActiveCompany = "" Then
                  TargetWb.Close False
                  Exit Sub
End If
'ActiveCompanyRow = ActiveCell.Row

'ask whether to send this Company to db
OverWrite = MsgBox("Add data for " & ActiveCompany & " to ee_agreement_base.xls?", vbYesNo)
            If OverWrite = vbNo Then Exit Sub

'activate TargetWb
TargetWb.Activate

'get last non-empty row in TargetWs
With TargetWs
    .Select
    .Range("A1").Select
End With
LastRowAgreementDb = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row

'search for the Company code in TargetWs
For i = 1 To LastRowAgreementDb
    If TargetWs.Range("A" & i).Value = ActiveCompany Then Exit For
Next
TargetCompanyRow = i

'set source and target range
Set SourceRange = SourceWs.Range("D2:D38")
Set SourceCompanyCodeRange = SourceWs.Range("B41")
Set TargetCompanyCodeRange = TargetWs.Range("A" & TargetCompanyRow)
Set TargetRange = TargetWs.Range("B" & TargetCompanyRow & ":AL" & TargetCompanyRow)

'overwrite company code in target ws
TargetCompanyCodeRange = SourceCompanyCodeRange.Value

'copy paste company data to target ws
SourceWs.Activate
SourceRange.Select
    Selection.Copy
    TargetWs.Activate
    TargetRange.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Application.CutCopyMode = False

'get last column
TargetWs.Activate
LastColTargetWs = Cells(1, Columns.Count).End(xlToLeft).Column

'sort agreement db alphabetically
If TargetCompanyRow > LastRowAgreementDb Then
   Set SortRange = TargetWs.Range(TargetWs.Cells(2, 1), TargetWs.Cells(TargetCompanyRow, LastColTargetWs))
       Else: Set SortRange = TargetWs.Range(TargetWs.Cells(2, 1), TargetWs.Cells(LastRowAgreementDb, LastColTargetWs))
End If
   
SortRange.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo

'close SourceWb
SourceWb.Close False

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = True
Application.AutomationSecurity = msoAutomationSecurityForceEnable

End Sub

Open in new window

0
stmoritz
Asked:
stmoritz
  • 7
  • 7
  • 7
1 Solution
 
SiddharthRoutCommented:
I guess because of this

If ActiveCompany = "" Then
                  TargetWb.Close False
                  Exit Sub
End If

Open in new window


I believe there is no value in Range("B41") and then it enters that loop and then exits the sub :)

Sid
0
 
Rory ArchibaldCommented:
Are you running this from a shortcut key combination and does the workbook you are opening have code in its Workbook_Open event?
0
 
stmoritzAuthor Commented:
hm.... there is a value in B41...
I upload both workbooks here
ee-agreement-base.xls
ee-company-details-BANANA.xls
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
SiddharthRoutCommented:
Well, I tried it and it works. I got the message which says

MsgBox("Add data for " & ActiveCompany & " to ee_agreement_base.xls?", vbYesNo)

Once thing that I notice which is different is that your file name in the code is

ee_company_details_BANANA.xls

But the Actual File name is

ee-company-details-BANANA.xls

Could that be the problem?

Sid
0
 
Rory ArchibaldCommented:
Remove this line:
'Application.AutomationSecurity = msoAutomationSecurityForceDisable

Open in new window

0
 
stmoritzAuthor Commented:
@Sid. uploading on ee changes _ to -    locally, this is correct.

@rorya: the file I am opening (not this test file) has code in it. with this line you suggest to remove I tried to avoid that the dialogue box appears to ask whether enable or disable macros. Is there another way to do this?
0
 
SiddharthRoutCommented:
Well, In that case, The macro ran fine on my pc.

Just enter this one line "MsgBox ActiveCompany" and tell me what do you see?

ActiveCompany = SourceWs.Range("B41").Value
MsgBox ActiveCompany
If ActiveCompany = "" Then
    TargetWb.Close False
    Exit Sub
End If

Open in new window


Sid
0
 
Rory ArchibaldCommented:
Use:
Application.AutomationSecurity = msoAutomationSecurityLow

Open in new window

0
 
stmoritzAuthor Commented:
unfortunately, I do not even get there (hope I did it correctly) it really exits before after this:
Set SourceWb = Workbooks.Open("C:\!ee\AgreementBase\ee_company_details_BANANA.xls")

'set and open workbooks
Set TargetWb = ActiveWorkbook
Set SourceWb = Workbooks.Open("C:\!ee\AgreementBase\ee_company_details_BANANA.xls")
'Set TargetWb = Workbooks("ee_agreement_base.xls")


'set worksheets
Set TargetWs = TargetWb.Sheets("AgreementData")
Set SourceWs = SourceWb.Sheets("CompanyData")

'activate SourceWb
SourceWb.Activate

'get Company Code to process
ActiveCompany = SourceWs.Range("B41").Value

MsgBox ("ActiveCompany")

Open in new window

0
 
SiddharthRoutCommented:
Ok Try this file and then tell me what all message boxes do you see?

Sid
ee-agreement-base.xls
0
 
stmoritzAuthor Commented:
@rorya: Application.AutomationSecurity = msoAutomationSecurityLow

works!

So I set it to Application.AutomationSecurity = msoAutomationSecurityMedium at the end again, right?

@Sid: sorry, MsgBox(ActiveCompany) (returns correct value)
0
 
Rory ArchibaldCommented:
If you set it to Application.AutomationSecurity = msoAutomationSecurityByUI it will use the same settings as the UI. In later versions of Excel it is Low by default.
0
 
SiddharthRoutCommented:
Gr8 then Rorya was bang on target :)

Sid
0
 
SiddharthRoutCommented:
Quick question Rory.

When I tried the original code it worked just fine?

Sid
0
 
Rory ArchibaldCommented:
Then you are using 2007 or later?
0
 
SiddharthRoutCommented:
Ah! Yes you are right.

Sid
0
 
stmoritzAuthor Commented:
@rorya

yeah, everything works great, except that my try

Application.AutomationSecurity = msoAutomationSecurityMedium

does not work.

how can i reset it that the dialogue box appears again to ask wheter to enable or disable macros?
0
 
Rory ArchibaldCommented:
Use msoAutomationSecurityByUI as I mentioned earlier! :)
0
 
stmoritzAuthor Commented:
he, who carefully reads expert's responses, has definitely an advantage! sorry rorya! :)
thanks
0
 
stmoritzAuthor Commented:
first class. thanks a lot.
0
 
Rory ArchibaldCommented:
Glad to help. :)
0

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

  • 7
  • 7
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now