Solved: How to make an existing VBA Macro Globally Accessible or Public

[deyken]

Hi All the EXCEL Experts!

I have written an extensive Macro that grabs a lot of data from an Excel file and uploads this data to a SQL SERVER 2008 Database. It works perfectly in the document where I created this marco originally, BUT I also need this to work on other Excel documents as well, without having to copy/paste the Macro code into each Workbook.

At our office, we create Excel reports for large construction projects. Each project has such an Excel report, that essentially outlines specific costs for specific types of services. Each such Excel report has (more or less) the same overall structure, which makes it possible for me to run this one macro I wrote on each document (it already dynamically grabs the data it needs for the SQL DB).

These Excel files (currently version 2007) are stored on a file server accesible to all financial staff members over the company internal network. I want the to be able to let each staff member open such an excel file, click a button (on the quick access toolbar) that runs my macro and then they can save and close this file and move on to the next one...

Can this be done? If so, how would I go about it? I know it needs to be declared as a Public Sub/Function, which I have already done. Initially I thought if I fire the Macro from a button on the QuickAccess toolbar it would work, but it keeps referring to the original file every time. How do I get this macro to work globally?

Looking forward to any assistance!!

[Bob Phillips]

You need to change the code to access a specific workbook, setting a workbook object to the workbook just opened. This also means opening the report from within the code.

You also need some means of launching the code, a button or a menu.

Other than that, it is hard to be specific without getting more details of your app and seeing some code.

[deyken]

Hi xld,

I think it would be better if I posted my code, because I am having no luck here:

[VBA]' Connect to this file and select required data from it
Public Sub UploadAllowables()
Dim WB As New Workbook
ThisWorkbook.Activate
Sheets("Sheet1").Activate
MsgBox "Project Code: " & ThisWorkbook.Sheets("Sheet1").Cells(8, "A"), vbInformation

' use this function to upload the current Excel Allowables Documents to the Allowables Database
Dim DB As New ADODB.Connection
DB.Open "Provider=SQLNCLI10.1;Integrated Security=SSPI;Persist Security Info=False;Data Source=PROJP002D830\SQLEXPRESS;Database=Allowables"

Dim RS As New ADODB.Recordset
RS.Open "SELECT * from tblALLOWABLES WHERE PROJECT_CODE = '" & PC & "'", DB, adOpenDynamic, adLockOptimistic

' Now assign all the relevant Fields to Variables for an upcoming loop

Dim Trade As String
Dim CCSCode As String
Dim ResourceName As String
Dim Unit As String
Dim Cost As Double
Dim Rate As Double
Dim Utilisation As Double
Dim Amount As Double
Dim Material As Double
Dim Transport As Double
Dim ProfServ As Double
Dim SBLabour As Double
Dim LogsStaff As Double
Dim PmOpsEng As Double
Dim Curr As String ' ZAR, USD, EUR
Dim ROE As Double

Dim LineStart As Integer
Dim LastLine As Integer
Dim CurrLine As Integer
Dim i As Integer
Dim Resource1 As String
Dim SuccessCounter As Integer
Dim AllowTOTAL As Double

AllowTOTAL = 0#
SuccessCounter = 0


If MsgBox("You are about to upload CCS/BuildSmart Allowables for Project: " & UCase(ProjectCode) & ". Do you want to go ahead?", vbYesNo, "Confirm Allowable Database Upload", 0, 0) = vbYes Then
' Determine Allowable Currency
If MsgBox("Is this Allowable offered in a Currency OTHER THAN SOUTH AFRICAN RANDS?", vbYesNo, "Confirm Allowable Currency", 0, 0) = vbYes Then
Curr = InputBox("Please provide this Allowable Currency Code (USD, GBP, BWP etc.)", "Provide Foreign Currency Code", "USD", 150, 150, 0, 0)
ROE = InputBox("Please provide the Rate of Exchange you used for Currency: " & Curr & "?", "Provide Rate of Exchange for " & Curr, "8.00", 150, 150, 0, 0)
Else
Curr = "ZAR"
ROE = "1.00"
End If

' ******************************** BEGIN IMPORT/UPLOAD DATA PROCESS **************************************************
' Step 1 - Get our start and Stop locations
LineStart = GetStartLine()
LastLine = GetStopLine()

' Step 2 - Run Loop through start/stop and assign veriables
For i = LineStart To LastLine
If Not IsEmptyLine(i) Then
Trade = ActiveWorkbook.Sheets(0).Cells(i, "A")
CCSCode = Sheet1.Cells(i, "B")
ResourceName = Sheet1.Cells(i, "C")
Unit = Sheet1.Cells(i, "D")
Cost = Sheet1.Cells(i, "E") ' CostCode as String
Rate = Sheet1.Cells(i, "F")
Utilisation = Sheet1.Cells(i, "G")
Amount = Sheet1.Cells(i, "H")
Material = Sheet1.Cells(i, "I")
Transport = Sheet1.Cells(i, "J")
ProfServ = Sheet1.Cells(i, "K")
SBLabour = Sheet1.Cells(i, "L")
LogsStaff = Sheet1.Cells(i, "M")
PmOpsEng = Sheet1.Cells(i, "N")

' Step 3 - Insert Data into the relevant DB Table
RS.AddNew
RS.Fields(1).Value = Replace(ProjectCode, " ", "")
RS.Fields(2).Value = Replace(Trade, " ", "")
RS.Fields(3).Value = Replace(CCSCode, " ", "")
RS.Fields(4).Value = RTrim(ResourceName)
RS.Fields(5).Value = Replace(Unit, " ", "")
RS.Fields(6).Value = Replace(Cost, " ", "")
RS.Fields(7).Value = Replace(Rate, " ", "")
RS.Fields(8).Value = Replace(Utilisation, " ", "")
RS.Fields(9).Value = Replace(Amount, " ", "")
RS.Fields(10).Value = Material
RS.Fields(11).Value = Transport
RS.Fields(12).Value = ProfServ
RS.Fields(13).Value = SBLabour
RS.Fields(14).Value = LogsStaff
RS.Fields(15).Value = PmOpsEng
RS.Fields(16).Value = Curr
RS.Fields(17).Value = ROE
RS.Update ' Record Added to Allowable Table

' If we reached this part, it was a successfull add - Increment the counter
SuccessCounter = SuccessCounter + 1
AllowTOTAL = AllowTOTAL + Amount
Else
' Skip the line if it is empty on this condition
End If ' end of IsEmptyLine condition
Next ' Next Allowable Line

' Confirm the work is done
MsgBox "Project: " & Sheet1.Cells(8, "A") & " has been uploaded to the Allowables Database. " & SuccessCounter & " Simple Resources were successfully uploaded. The Project Total Allowable = " & Format(AllowTOTAL, "R###,###,##0.00"), vbInformation

' Now AutoSave this file with the correct naming convention to the F:\ Drive MATRIX Folder

End If
End Sub
Function GetStopLine()
Columns("C:C").Select
ActiveWorkbook.Sheets("Sheet1").Range("C2").Activate
ActiveWorkbook.Sheets("Sheet1").Selection.Find(What:="SIMPLE TOTAL", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
GetStopLine = ActiveCell.Row - 2
Range("A8").Select
End Function
Function GetStartLine()
Columns("C:C").Select
ActiveWorkbook.Sheets("Sheet1").Range("C2").Activate
ActiveWorkbook.Sheets("Sheet1").Selection.Find(What:="SIMPLE RESOURCES", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
GetStartLine = ActiveCell.Row + 2
End Function
Sub FindSimples()
'
' FindSimples Macro
'
'
Columns("C:C").Select
Range("C2").Activate
Selection.Find(What:="SIMPLE TOTAL", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
End Sub
Function IsEmptyLine(LineNo As Integer) As Boolean
' Check if the entire line is empty so it can be skipped
With Sheet1
If (.Cells(LineNo, "A") = "") And (.Cells(LineNo, "B") = "") And (.Cells(LineNo, "C") = "") And (.Cells(LineNo, "D") = "") And (.Cells(LineNo, "E") = "") And (.Cells(LineNo, "F") = "") And (.Cells(LineNo, "G") = "") And (.Cells(LineNo, "H") = "") And (.Cells(LineNo, "I") = "") And (.Cells(LineNo, "J") = "") And (.Cells(LineNo, "K") = "") And (.Cells(LineNo, "L") = "") And (.Cells(LineNo, "M") = "") And (.Cells(LineNo, "N") = "") Then
IsEmptyLine = True
Else
IsEmptyLine = False
End If
End With
End Function
Function FileExists(FullFileName As String) As Boolean
' returns TRUE if the file exists
FileExists = Len(Dir(FullFileName)) > 0
End Function



[/VBA]

I am certain I am doing something wrong somewhere in this block of code. Opening the file through VBA code is proving to be a challenge, because (as Murphy's Law would have it) my users all use different versions of Excel. So, instead I attemp to access the Sheets and Cell carrying my Database information through the ActiveWorkbook and/or the ThisWorkbook functions. It does not seem to work, however.

Any suggestions?

[Bob Phillips]

How is the workbook to be uploaded selected/opened/arrived at?

[Jan Karel Pieterse]

I had a quick look at your code.
This line:

Dim WB as New Workbook

can be removed, you don't use that variable.
Also, do not declare variables using the New keyword, it is considered bad practice.

If you use Sheet1.Range, you are -by definition- referring to the code name of a worksheet *inside* the ThisWorkbook object (the workbook holding the code). To address Sheet1 of the active workbook, use the following syntax:

Worksheets("Sheet1").WhateverObjectMethodOrPropertyYouNeed

I expect this article will be of help:
www.jkp-ads.com/articles/distributemacro.asp

[deyken]

Hi Jan Karel,

That is exactly what I thought. ActiveWorkbook is implied, at least while a workbook is indeed currently open. This is also why I am stumped, since trying to access data in a Cell delivers either a Null or Empty string...

XLD

I am going to ask the users to open the Excel files directly from the server, after which they will run this macro from a Quick Access toolbar button.

What am I doing wrong in my code?

[Bob Phillips]

I am suggesting that the code does the opening.

have looked at the code and it is quite straightforward apart from the functions. Do they all act upon the report workbook that is opened?

[deyken]

I had a quick look at your code.
This line:

Dim WB as New Workbook

can be removed, you don't use that variable.
Also, do not declare variables using the New keyword, it is considered bad practice.

If you use Sheet1.Range, you are -by definition- referring to the code name of a worksheet *inside* the ThisWorkbook object (the workbook holding the code). To address Sheet1 of the active workbook, use the following syntax:

Worksheets("Sheet1").WhateverObjectMethodOrPropertyYouNeed

I expect this article will be of help:
www.jkp-ads.com/articles/distributemacro.asp

Hi Jan Karel,

Thank you very much. This worked perfectly. I can now distribute my Macro to the users.

Thank you very very much! Much appreciated!!

Deyken

[Jan Karel Pieterse]

:-) You're welcome.