I require VBA Code to automatically sync certain cell data to a seperate excel template

**Peter W** · 03-17-2014, 05:04 AM

Hello all,

Forum newbie, excel novice - moderate user, I hope I wont be too much of a pain for you.

I will start by saying, I understand that I am likely better off using access for this particular job, however, I have no experience of using access, nor a copy of it, nor the time to change too much of my current system, so ideally would like to find a way to make this work using excel only (hopefully not too big of an ask).

I have created a "Tenancy Information" workbook template and I use a seperate document for each tenant, creating a document titled "Client 1 - Tenant Information", "Client 2 - Tenancy Information", etc ("Client 1" would actually read the clients name, say "J. Smith").

I also have generic excel forms, which collect data from these tenancy info sheets, which I can save as PDF and then forward to my clients. What I would like to do, if possible, is have a macro (activated by clicking a button within the "Tenancy Info" document) that would take the relevant data and open it up in said excel form document. I currently have to open each document and pair the relevant cells, which can prove timely.

To give you a brief example:

Tenant Information Form:

Would need to take the:

FIELD (CELL)

1) Client name (B4)
2) Booked Property (B5)
3) Start Date (E4)
4) End Date (E5)
5) Booking Ref No. (B3)

All of this information would be in the same relevant cells in the "tenant info" document.

Some time ago, I found some code, which would perform a similar exercise, where it takes information from specific cells and opens outlook with an email template, so I am hoping it can do this within excel also.

Any ideas / help would be greatly appreciated.

Thanks

Peter

------------

As an addendum to the original question:

I wonder if there is a way to only have to pair one cell in an excel form template to the "tenancy info" sheet and have the other cells tie in to that one cell so they can collect their data?

I.E something along the lines of:

='[SheetofB1]Main'!$C$6

And when you pair B1 to say, "J.Smith - Tenancy Information" you would get:

='[J.Smith - Tenancy Information.xlsm]Main'!$C$6

and so on?

Would this work and / or be simpler than my original request?

**Bernie Deitrick** · 03-17-2014, 12:05 PM

This code will create links to specific cells - you can convert the formula to a value if you want to break the link. Give it a try ans see if it does what you want, then post back if you want different behavior (and post how you modified the code, too).

Sub MakeLinksUsingGetOpenFileName()
    Dim strFileWithData As String
    Dim strFormula As String
    Dim strSheetName As String
    Dim strPath As String
    Dim strFilename As String

    strFileWithData = Application.GetOpenFilename(Title:="Select the file with the data")

    strSheetName = "Main"  'Make sure this is the sheet name with the data you want
    strPath = Left(strFileWithData, InStrRev(strFileWithData, "\"))
    strFilename = Split(strFileWithData, "\")(UBound(Split(strFileWithData, "\")))
    
    'Generate strFormula through string manipulation
    strFormula = "='" & strPath & "[" & _
                 strFilename _
                 & "]" & strSheetName & " '!"
                 
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    'Set cell formulas - I hope you see the pattern
    With ThisWorkbook.WorkSheets("Tenancy Info")  'Make sure the sheet name is correct
        .Range("B1").Formula = strFormula & "C6"  'Create a link in B1 to cell C6
        .Range("B2").Formula = strFormula & "E2"
        .Range("B3").Formula = strFormula & "J7"
        .Range("B4").Formula = strFormula & "H9"
        .Range("B5").Formula = strFormula & "K5"
        .Range("B6").Formula = strFormula & "M4"
    End With
    
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub

**Peter W** · 03-18-2014, 07:04 AM

Hi Bernie,

I did send a response yesterday afternoon thanking you for your time, but it doesn't appear to have shown up, so apologies.

I have been playing around with this code, but with little success. As I alluded to, I am somewhat of a novice, especially as far as VBA / macros are concerned.

I assume this code runs from the form template, rather than the tenancy system files which I save for each separate client?

Is this the best way round for me to complete this task, or should I run the code from within the tenants workbook via clicking a created button?

I currently use a "sendmail" operation this way, which opens up outlook and inserts the required information in to the relevant email fields (email address, subject, message body and signature).

I have included a copy of this code below, as it may explain how it works better than I am (that wouldn't be too hard

)

Any thoughts / ideas would be greatly appreciated. I have a tendency to sometimes over complicate things and given as I am not 100% sure what I'm doing here, would like to keep things as simple as possible.

------------

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Email = Cells(ActiveCell.Row, 7)

Subj = Cells(ActiveCell.Row, 9)

Msg = Msg & "Dear " & Cells(ActiveCell.Row, 8) & "," & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 10) & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 11) & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 12) & vbCrLf & Cells(ActiveCell.Row, 13) & vbCrLf & Cells(ActiveCell.Row, 14) & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 15) & vbCrLf & vbCrLf & "Kind regards," & vbCrLf & vbCrLf & "Peter."

'Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

'Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

'Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

'Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

'Wait two seconds before sending keystrokes
'Application.Wait (Now + TimeValue("0:00:04"))
'Application.SendKeys "%s"
End Sub
Sub InsertSig(strSigName As String)
Dim objItem As Object
Dim objInsp As Outlook.Inspector
' requires a project reference to the
' Microsoft Word library
Dim objDoc As Word.Document
Dim objSel As Word.Selection
' requires a project reference to the
' Microsoft Office library
Dim objCB As Office.CommandBar
Dim objCBP As Office.CommandBarPopup
Dim objCBB As Office.CommandBarButton
Dim colCBControls As Office.CommandBarControls
On Error Resume Next

Set objInsp = Application.ActiveInspector
If Not objInsp Is Nothing Then
Set objItem = objInsp.CurrentItem
If objItem.Class = olMail Then ' editor is WordMail
If objInsp.EditorType = olEditorWord Then
' next statement will trigger security prompt
' in Outlook 2002 SP3
Set objDoc = objInsp.WordEditor
Set objSel = objDoc.Application.Selection
If objDoc.Bookmarks("_MailAutoSig") Is Nothing Then
objDoc.Bookmarks.Add Range:=objSel.Range, Name:="_MailAutoSig"
End If
objSel.Goto What:=wdGoToBookmark, Name:="_MailAutoSig"
Set objCB = objDoc.CommandBars("AutoSignature Popup")
If Not objCB Is Nothing Then
Set colCBControls = objCB.Controls
End If
Else ' editor is not WordMail
' get the Insert | Signature submenu
Set objCBP = Application.ActiveInspector.CommandBars.FindControl(, 31145)
If Not objCBP Is Nothing Then
Set colCBControls = objCBP.Controls
End If
End If
End If
If Not colCBControls Is Nothing Then
For Each objCBB In colCBControls
If objCBB.Caption = strSigName Then
objCBB.Execute ' **** see remarks
Exit For
End If
Next
End If
End If

Set objInsp = Nothing
Set objItem = Nothing
Set objDoc = C: .Users.Peter Wade.AppData.Roaming.Microsoft.Signatures
Set objSel = Nothing
Set objCB = Nothing
Set objCBB = Nothing
End Sub

**Bernie Deitrick** · 03-18-2014, 09:34 AM

The code that I posted should go in your "said excel form document" If you post a (private info removed) copy of your form document - indicate what information goes where - along with a sample Tenancy Info document (with the data that is needed highlighted), I will add the code to the form to pull the correct data.

I require VBA Code to automatically sync certain cell data to a seperate excel template

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

I require VBA Code to automatically sync certain cell data to a seperate excel template

Re: I require VBA Code to automatically sync certain cell data to a seperate excel templat

Re: I require VBA Code to automatically sync certain cell data to a seperate excel templat

Re: I require VBA Code to automatically sync certain cell data to a seperate excel templat

Thread Information

Users Browsing this Thread

Similar Threads

Need code for two lists, seperate worksheets, both to update eachother automatically.

Need to automatically extract figures from excel data set to word template.

Excel 2007 : Automatically change Data in one cell if it matches another cell on a seperate sheet

Print data in each row on a seperate sheet template

[SOLVED] Excel template to load automatically as the default template?

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions