PDA

View Full Version : Macro to import/export data



Magicry
01-30-2012, 08:46 AM
Hi ,

My knowledge of VBA and macros on Excel is very limited but have been given the task of re-writing/updating a rating tool that calculates insurance premium on roughly 800 different variances.

Basically the tool is opened empty, i then key in the information, get the quote and save the whole tool as the clients name ( therefore creating a copy of the tool specific to that client ) , this creates a problem.

The problem is that if i update the tool and the rates in say a years time, it will not update existing clients as i will only be altering the original and not the copies.

What i want the tool to do is export the data into a data file that can then be imported back in at a later date. Can this be done so a simple export and import button is shown at top of Sheet at all times?

Thank you for your help in advance..

Ryan :banghead:

Zack Barresse
01-30-2012, 11:15 AM
Hello Ryan, welcome to the board!

Sounds very frustrating. Is there any way you can give us some details about the data structure? What version of Excel are you working on? What are the file types? Do you want to leverage the Ribbon with this? I'm assuming you can't share the file with us if it deals with client insurance information, and if not can you just show us a sample of the data with dummy information? Or at least describe it in detail?

The more details you provide, the most specific of a solution we can help you with. :)

Magicry
01-31-2012, 03:37 AM
Thanks for your fast reply.

I have attached a blank copy of the excell workbook with irrelevant pages deleted.

The page showing contains all data which is dragged from a form VBA. VBA password is "mylittlesecret"

This is the data that changes per client , the rest of the workbook drags the info from this one page.

Many thanks

Magicry
01-31-2012, 03:39 AM
im using excel 2007 by the way.

thanks

Zack Barresse
01-31-2012, 06:12 PM
We need you to explicitly tell us what you want. You say you want to export and import data, but you need to identify exactly what data. Or do you just want to import the entire worksheet? Is it the "New Rating Layout" worksheet? How would you want this to work, to hit a button, select a file to import, clears the data in the workbook 'master', copies the data from the imported workbook into the 'master' worksheet? Details please. :)

Magicry
02-01-2012, 02:12 AM
Right...

I need it it to duplicate the whole sheet ( New Rating Layout) and save it as single worksheet. The import would need to overwrite the existing "New Rating Layout" with the saved copy.

The would be ideally done as two seperate buttons, one for import, one for export.

The problem is that the sheet is "very" hidden when the quote program is running! This complicates the matter further.

regards

Zack Barresse
02-01-2012, 11:20 AM
Lightly tested...

Option Explicit

Private Const sWsName As String = "New Rating Layout"

Dim wbOrig As Workbook
Dim wbDest As Workbook
Dim wsOrig As Worksheet
Dim wsDest As Worksheet
Dim bOpen As Boolean
Dim bRanOK As Boolean
Dim vFile As Variant
Dim sName As String
Dim sPath As String
Dim sPrompt As String

Sub ImportData()
bRanOK = False
If WSEXISTS(sWsName, ThisWorkbook) = False Then
MsgBox "The worksheet '" & sWsName & "' does not exists in this file.", vbCritical, "ERROR!"
Exit Sub
End If
vFile = Application.GetOpenFilename("Import File (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb")
If vFile = "False" Then Exit Sub
sName = Right(vFile, Len(vFile) - InStrRev(vFile, Application.PathSeparator))
sPath = Left(vFile, Len(vFile) - Len(sName))
Call TOGGLEEVENTS(False)
If WBISOPEN(sName) = True Then
Set wbOrig = Workbooks(sName)
bOpen = True
Else
Set wbOrig = Workbooks.Open(sPath & sName)
bOpen = False
End If
If WSEXISTS(sWsName, wbOrig) = False Then
sPrompt = "The worksheet '" & sWsName & "' in '" & sName & "' does not exist."
MsgBox sPrompt, vbCritical, "ERROR!"
GoTo ExitRoutine
End If
Set wsOrig = wbOrig.Worksheets(sWsName)
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Worksheets(sWsName)
sPrompt = "Are you sure you want to clear the current '" & sWsName & "' worksheet and import new data? This cannot be undone."
If MsgBox(sPrompt, vbYesNo + vbDefaultButton2, "IMPORT?") <> vbYes Then GoTo ExitRoutine
wsDest.Cells.Clear
wsOrig.UsedRange.Copy
wsDest.Range("A1").PasteSpecial xlPasteAll
bRanOK = True
ExitRoutine:
If bOpen = False Then wbOrig.Close False
Call TOGGLEEVENTS(True)
Set wbDest = Nothing
Set wbOrig = Nothing
Set wsDest = Nothing
Set wsOrig = Nothing
If bRanOK = True Then
MsgBox "Import completed OK.", vbOKOnly, "FINISHED!"
End If
End Sub

Sub ExportData()
bRanOK = False
If WSEXISTS(sWsName, ThisWorkbook) = False Then
MsgBox "The worksheet '" & sWsName & "' does not exists in this file.", vbCritical, "ERROR!"
Exit Sub
End If
vFile = Application.GetSaveAsFilename(sWsName & ".xlsx", "Export File (*.xlsx), *.xlsx")
If vFile = "False" Then Exit Sub
sName = Right(vFile, Len(vFile) - InStrRev(vFile, Application.PathSeparator))
sPath = Left(vFile, Len(vFile) - Len(sName))
If LCase(Right(sName, 5)) <> ".xlsx" Then
MsgBox "You must save as an XLSX file type.", vbCritical, "ERROR!"
Exit Sub
End If
If Len(Dir(sPath & sName, vbNormal)) > 0 Then
MsgBox "That file name already exists.", vbCritical, "ERROR!"
Exit Sub
End If
On Error GoTo ErrHandle
Call TOGGLEEVENTS(False)
Set wbOrig = ThisWorkbook
Set wsOrig = wbOrig.Worksheets(sWsName)
Set wbDest = Workbooks.Add(xlWBATWorksheet)
Set wsDest = wbDest.Worksheets(1)
wsDest.Name = sWsName
wsOrig.UsedRange.Copy
wsDest.Range("A1").PasteSpecial xlPasteAll
wbDest.SaveAs sPath & sName, 51
bRanOK = True
ErrHandle:
Call TOGGLEEVENTS(True)
If bRanOK = True Then
MsgBox "Export completed OK.", vbOKOnly, "FINISHED!"
End If
End Sub

Public Function WBISOPEN(wkbName As String) As Boolean
On Error Resume Next
WBISOPEN = CBool(Workbooks(wkbName).Name <> "")
On Error GoTo 0
End Function

Public Function WSEXISTS(wksName As String, Optional WKB As Workbook) As Boolean
If WKB Is Nothing Then
If ActiveWorkbook Is Nothing Then Exit Function
Set WKB = ActiveWorkbook
End If
On Error Resume Next
WSEXISTS = CBool(WKB.Worksheets(wksName).Name <> "")
On Error GoTo 0
End Function

Public Sub TOGGLEEVENTS(blnState As Boolean)
'Originally written by Zack Barresse
With Application
If Not blnState And Not ActiveWorkbook Is Nothing Then .Calculation = xlCalculationManual
.DisplayAlerts = blnState
.EnableEvents = blnState
.ScreenUpdating = blnState
If blnState Then .CutCopyMode = False
If blnState Then .StatusBar = False
If blnState And Not ActiveWorkbook Is Nothing Then .Calculation = xlCalculationAutomatic
End With
End Sub

Code must go into your 'master' workbook in a standard module.

HTH

Magicry
02-06-2012, 04:15 AM
Lightly tested...

Option Explicit

Private Const sWsName As String = "New Rating Layout"

Dim wbOrig As Workbook
Dim wbDest As Workbook
Dim wsOrig As Worksheet
Dim wsDest As Worksheet
Dim bOpen As Boolean
Dim bRanOK As Boolean
Dim vFile As Variant
Dim sName As String
Dim sPath As String
Dim sPrompt As String

Sub ImportData()
bRanOK = False
If WSEXISTS(sWsName, ThisWorkbook) = False Then
MsgBox "The worksheet '" & sWsName & "' does not exists in this file.", vbCritical, "ERROR!"
Exit Sub
End If
vFile = Application.GetOpenFilename("Import File (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb")
If vFile = "False" Then Exit Sub
sName = Right(vFile, Len(vFile) - InStrRev(vFile, Application.PathSeparator))
sPath = Left(vFile, Len(vFile) - Len(sName))
Call TOGGLEEVENTS(False)
If WBISOPEN(sName) = True Then
Set wbOrig = Workbooks(sName)
bOpen = True
Else
Set wbOrig = Workbooks.Open(sPath & sName)
bOpen = False
End If
If WSEXISTS(sWsName, wbOrig) = False Then
sPrompt = "The worksheet '" & sWsName & "' in '" & sName & "' does not exist."
MsgBox sPrompt, vbCritical, "ERROR!"
GoTo ExitRoutine
End If
Set wsOrig = wbOrig.Worksheets(sWsName)
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Worksheets(sWsName)
sPrompt = "Are you sure you want to clear the current '" & sWsName & "' worksheet and import new data? This cannot be undone."
If MsgBox(sPrompt, vbYesNo + vbDefaultButton2, "IMPORT?") <> vbYes Then GoTo ExitRoutine
wsDest.Cells.Clear
wsOrig.UsedRange.Copy
wsDest.Range("A1").PasteSpecial xlPasteAll
bRanOK = True
ExitRoutine:
If bOpen = False Then wbOrig.Close False
Call TOGGLEEVENTS(True)
Set wbDest = Nothing
Set wbOrig = Nothing
Set wsDest = Nothing
Set wsOrig = Nothing
If bRanOK = True Then
MsgBox "Import completed OK.", vbOKOnly, "FINISHED!"
End If
End Sub

Sub ExportData()
bRanOK = False
If WSEXISTS(sWsName, ThisWorkbook) = False Then
MsgBox "The worksheet '" & sWsName & "' does not exists in this file.", vbCritical, "ERROR!"
Exit Sub
End If
vFile = Application.GetSaveAsFilename(sWsName & ".xlsx", "Export File (*.xlsx), *.xlsx")
If vFile = "False" Then Exit Sub
sName = Right(vFile, Len(vFile) - InStrRev(vFile, Application.PathSeparator))
sPath = Left(vFile, Len(vFile) - Len(sName))
If LCase(Right(sName, 5)) <> ".xlsx" Then
MsgBox "You must save as an XLSX file type.", vbCritical, "ERROR!"
Exit Sub
End If
If Len(Dir(sPath & sName, vbNormal)) > 0 Then
MsgBox "That file name already exists.", vbCritical, "ERROR!"
Exit Sub
End If
On Error GoTo ErrHandle
Call TOGGLEEVENTS(False)
Set wbOrig = ThisWorkbook
Set wsOrig = wbOrig.Worksheets(sWsName)
Set wbDest = Workbooks.Add(xlWBATWorksheet)
Set wsDest = wbDest.Worksheets(1)
wsDest.Name = sWsName
wsOrig.UsedRange.Copy
wsDest.Range("A1").PasteSpecial xlPasteAll
wbDest.SaveAs sPath & sName, 51
bRanOK = True
ErrHandle:
Call TOGGLEEVENTS(True)
If bRanOK = True Then
MsgBox "Export completed OK.", vbOKOnly, "FINISHED!"
End If
End Sub

Public Function WBISOPEN(wkbName As String) As Boolean
On Error Resume Next
WBISOPEN = CBool(Workbooks(wkbName).Name <> "")
On Error GoTo 0
End Function

Public Function WSEXISTS(wksName As String, Optional WKB As Workbook) As Boolean
If WKB Is Nothing Then
If ActiveWorkbook Is Nothing Then Exit Function
Set WKB = ActiveWorkbook
End If
On Error Resume Next
WSEXISTS = CBool(WKB.Worksheets(wksName).Name <> "")
On Error GoTo 0
End Function

Public Sub TOGGLEEVENTS(blnState As Boolean)
'Originally written by Zack Barresse
With Application
If Not blnState And Not ActiveWorkbook Is Nothing Then .Calculation = xlCalculationManual
.DisplayAlerts = blnState
.EnableEvents = blnState
.ScreenUpdating = blnState
If blnState Then .CutCopyMode = False
If blnState Then .StatusBar = False
If blnState And Not ActiveWorkbook Is Nothing Then .Calculation = xlCalculationAutomatic
End With
End Sub

Code must go into your 'master' workbook in a standard module.

HTH




Thanks so much for the above Zack. It seems to work great, will do some heavy testing today but so far so good.

Thanks allot for your help and time.

regards

Ryan

Magicry
02-06-2012, 07:54 AM
Sorry to bother you again Zack, but have encountered another problem.

Can the code be altered so that it will do exactly the same thing, but export a sheet named Renewal data but save it as "New Rating Layout" so can be imported as if it was the original "New rating layout".

Sorry if this doesn't make sense

regards

Magicry
02-09-2012, 05:37 AM
Is it possible to link a text box on a User form to more than one cell?

Zack Barresse
04-25-2012, 12:21 AM
Sorry I didn't see this sooner.

You can make the export change with this added constant to the top (right below or above the other one)...



Private Const sWsExport As String = "Renewal data"

And your Export routine would look like this (just a few variable name changes)...


Sub ExportData()
bRanOK = False
If WSEXISTS(sWsExport, ThisWorkbook) = False Then
MsgBox "The worksheet '" & sWsExport & "' does not exists in this file.", vbCritical, "ERROR!"
Exit Sub
End If
vFile = Application.GetSaveAsFilename(sWsExport & ".xlsx", "Export File (*.xlsx), *.xlsx")
If vFile = "False" Then Exit Sub
sName = Right(vFile, Len(vFile) - InStrRev(vFile, Application.PathSeparator))
sPath = Left(vFile, Len(vFile) - Len(sName))
If LCase(Right(sName, 5)) <> ".xlsx" Then
MsgBox "You must save as an XLSX file type.", vbCritical, "ERROR!"
Exit Sub
End If
If Len(Dir(sPath & sName, vbNormal)) > 0 Then
MsgBox "That file name already exists.", vbCritical, "ERROR!"
Exit Sub
End If
On Error GoTo ErrHandle
Call TOGGLEEVENTS(False)
Set wbOrig = ThisWorkbook
Set wsOrig = wbOrig.Worksheets(sWsExport)
Set wbDest = Workbooks.Add(xlWBATWorksheet)
Set wsDest = wbDest.Worksheets(1)
wsDest.Name = sWsName
wsOrig.UsedRange.Copy
wsDest.Range("A1").PasteSpecial xlPasteAll
wbDest.SaveAs sPath & sName, 51
bRanOK = True
ErrHandle:
Call TOGGLEEVENTS(True)
If bRanOK = True Then
MsgBox "Export completed OK.", vbOKOnly, "FINISHED!"
End If
End Sub

As to your second question, it depends. If you're talking about a worksheet control, just use a formula to reference the linked cell, i.e. =A1. If you're talking about a UserForm control, those are completely up to you to control where the value goes where. So yes, you can set the control value to go wherever you want. If you're talking about the ControlSource property, then no, you can only link that property to a single cell.