Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel VBA - Updating of data problem
I hope some of u can help me with this..
I'm required to update the data from several files into a list..that i done. The problem is: the user can update a file twice which would lea to data inaccuracy when analysing the data using Pivot Tables. My code goes like this: Sub ImportRangeFromWB(SourceSheet As String, _ SourceAddress As String, PasteValuesOnly As Boolean, _ TargetWB As String, TargetWS As String, TargetAddress As String) 'Imports the data i Workbooks(SourceFile).Worksheets(SourceSheet).Rang e(SourceAddress) 'to Workbooks(TargetWB).Worksheets(TargetWS).Range(Tar getAddress) 'Replaces existing data in Workbooks(TargetWB).Worksheets(TargetWS) 'without prompting for confirmation 'Example 'ImportRangeFromWB "C:\FolderName\TargetWB.xls", _ "Sheet1", "A1:E21", True, ThisWorkbook.Name, "ImportSheet", "A3" Dim SourceFile As String Dim SourceWB As Workbook, SourceWS As String, SourceRange As Range Dim TargetRange As Range, A As Integer, tString As String Dim i As Integer Dim CellValue As String 'validate the input data if necessary SourceFile = Application.GetOpenFilename("Excel Files,*.xls") If Dir(SourceFile) = "" Then Exit Sub 'SourceFile doesn't exist If Dir(SourceFile) < "" Then MsgBox "You have updated this file before. Are you sure yo want to overwrite the previous date?", vbYesNo End If Set SourceWB = Workbooks.Open(SourceFile, True, True) Application.StatusBar = "Reading data from " & SourceFile Workbooks(TargetWB).Activate Worksheets(TargetWS).Activate 'perform input Application.ScreenUpdating = False Set TargetRange = Range(TargetAddress).Cells(1, 1) Set SourceRange SourceWB.Worksheets(SourceSheet).Range(SourceAddre ss) For A = 1 To SourceRange.Areas.Count SourceRange.Areas(A).Copy If SourceRange.Areas.Count 1 Then Set TargetRange = _ TargetRange.Offset(TargetRange.Areas(A).Rows.Count , 1) End If i = 5 For i = 5 To 5000 CellValue = Cells(i, 3) If CellValue = "" Then Set TargetRange = Cells(i, 3) i = 5000 End If Next i If PasteValuesOnly Then TargetRange.PasteSpecial xlPasteValues TargetRange.PasteSpecial xlPasteFormats Else TargetRange.PasteSpecial xlPasteAll End If Application.CutCopyMode = False Next A 'clean up 'Set SourceRange = Nothing 'Set TargetRange = Nothing Range(TargetAddress).Cells(1, 1).Select SourceWB.Close False Set SourceWB = Nothing Application.StatusBar = False End Sub Can anyone help me with this? Thank you -- Message posted from http://www.ExcelForum.com |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel VBA - Updating of data problem
You ask a question using the message box but don't use
the results. Sub ImportRangeFromWB(SourceSheet As String, _ IF MsgBox( "You have updated this file before. Are you sure you " _ & "want to overwrite the previous date?", vbYesNo)=VBNo then exit sub End If -----Original Message----- I hope some of u can help me with this.. I'm required to update the data from several files into a list..that is done. The problem is: the user can update a file twice which would lead to data inaccuracy when analysing the data using Pivot Tables. My codes goes like this: Sub ImportRangeFromWB(SourceSheet As String, _ SourceAddress As String, PasteValuesOnly As Boolean, _ TargetWB As String, TargetWS As String, TargetAddress As String) 'Imports the data in Workbooks(SourceFile).Worksheets(SourceSheet).Ran ge (SourceAddress) 'to Workbooks(TargetWB).Worksheets(TargetWS).Range (TargetAddress) 'Replaces existing data in Workbooks(TargetWB).Worksheets (TargetWS) 'without prompting for confirmation 'Example 'ImportRangeFromWB "C:\FolderName\TargetWB.xls", _ "Sheet1", "A1:E21", True, ThisWorkbook.Name, "ImportSheet", "A3" Dim SourceFile As String Dim SourceWB As Workbook, SourceWS As String, SourceRange As Range Dim TargetRange As Range, A As Integer, tString As String Dim i As Integer Dim CellValue As String 'validate the input data if necessary SourceFile = Application.GetOpenFilename("Excel Files,*.xls") If Dir(SourceFile) = "" Then Exit Sub 'SourceFile doesn't exist If Dir(SourceFile) < "" Then MsgBox "You have updated this file before. Are you sure you want to overwrite the previous date?", vbYesNo End If Set SourceWB = Workbooks.Open(SourceFile, True, True) Application.StatusBar = "Reading data from " & SourceFile Workbooks(TargetWB).Activate Worksheets(TargetWS).Activate 'perform input Application.ScreenUpdating = False Set TargetRange = Range(TargetAddress).Cells(1, 1) Set SourceRange = SourceWB.Worksheets(SourceSheet).Range(SourceAddr ess) For A = 1 To SourceRange.Areas.Count SourceRange.Areas(A).Copy If SourceRange.Areas.Count 1 Then Set TargetRange = _ TargetRange.Offset(TargetRange.Areas(A).Rows.Coun t, 1) End If i = 5 For i = 5 To 5000 CellValue = Cells(i, 3) If CellValue = "" Then Set TargetRange = Cells(i, 3) i = 5000 End If Next i If PasteValuesOnly Then TargetRange.PasteSpecial xlPasteValues TargetRange.PasteSpecial xlPasteFormats Else TargetRange.PasteSpecial xlPasteAll End If Application.CutCopyMode = False Next A 'clean up 'Set SourceRange = Nothing 'Set TargetRange = Nothing Range(TargetAddress).Cells(1, 1).Select SourceWB.Close False Set SourceWB = Nothing Application.StatusBar = False End Sub Can anyone help me with this? Thank you. --- Message posted from http://www.ExcelForum.com/ . |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel VBA - Updating of data problem
Thank you Patrick Molloy,
Now my code looks like this.. 'validate the input data if necessary SourceFile = Application.GetOpenFilename("Excel Files,*.xls") If Dir(SourceFile) = "" Then Exit Sub 'SourceFile doesn't exist If Dir(SourceFile) < "" Then If MsgBox("You can only update a file once.have updated thi file before. Are you sure you want to overwrite the previous date?" vbYesNo) = vbNo Then Exit Sub End If End If Set SourceWB = Workbooks.Open(SourceFile, True, True) Application.StatusBar = "Reading data from " & SourceFile Workbooks(TargetWB).Activate Worksheets(TargetWS).Activate What happens if i want to restrict the users to update a file onl once? -----Original Message----- I hope some of u can help me with this.. I'm required to update the data from several files into a list..that is done. The problem is: the user can update a file twice which would lead to data inaccuracy when analysing the data using Pivot Tables. My codes goes like this: Sub ImportRangeFromWB(SourceSheet As String, _ SourceAddress As String, PasteValuesOnly As Boolean, _ TargetWB As String, TargetWS As String, TargetAddress As String) 'Imports the data in Workbooks(SourceFile).Worksheets(SourceSheet).Ran ge (SourceAddress) 'to Workbooks(TargetWB).Worksheets(TargetWS).Range (TargetAddress) 'Replaces existing data in Workbooks(TargetWB).Worksheets (TargetWS) 'without prompting for confirmation 'Example 'ImportRangeFromWB "C:\FolderName\TargetWB.xls", _ "Sheet1", "A1:E21", True, ThisWorkbook.Name, "ImportSheet", "A3" Dim SourceFile As String Dim SourceWB As Workbook, SourceWS As String, SourceRange As Range Dim TargetRange As Range, A As Integer, tString As String Dim i As Integer Dim CellValue As String 'validate the input data if necessary SourceFile = Application.GetOpenFilename("Excel Files,*.xls") If Dir(SourceFile) = "" Then Exit Sub 'SourceFile doesn't exist If Dir(SourceFile) < "" Then MsgBox "You have updated this file before. Are you sure you want to overwrite the previous date?", vbYesNo End If Set SourceWB = Workbooks.Open(SourceFile, True, True) Application.StatusBar = "Reading data from " & SourceFile Workbooks(TargetWB).Activate Worksheets(TargetWS).Activate 'perform input Application.ScreenUpdating = False Set TargetRange = Range(TargetAddress).Cells(1, 1) Set SourceRange = SourceWB.Worksheets(SourceSheet).Range(SourceAddr ess) For A = 1 To SourceRange.Areas.Count SourceRange.Areas(A).Copy If SourceRange.Areas.Count 1 Then Set TargetRange = _ TargetRange.Offset(TargetRange.Areas(A).Rows.Coun t, 1) End If i = 5 For i = 5 To 5000 CellValue = Cells(i, 3) If CellValue = "" Then Set TargetRange = Cells(i, 3) i = 5000 End If Next i If PasteValuesOnly Then TargetRange.PasteSpecial xlPasteValues TargetRange.PasteSpecial xlPasteFormats Else TargetRange.PasteSpecial xlPasteAll End If Application.CutCopyMode = False Next A 'clean up 'Set SourceRange = Nothing 'Set TargetRange = Nothing Range(TargetAddress).Cells(1, 1).Select SourceWB.Close False Set SourceWB = Nothing Application.StatusBar = False End Sub Can anyone help me with this? Thank you -- Message posted from http://www.ExcelForum.com |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Updating Problem with Large Excel File | Excel Discussion (Misc queries) | |||
Bizarre Excel 03 Problem - autosum not updating when cells are cha | Excel Worksheet Functions | |||
Problem in updating the Powerpoint Embedded Chart with Excel figur | Charts and Charting in Excel | |||
Problem with updating links in Excel 2003 | Excel Worksheet Functions | |||
Problem with updating links in Excel 2003 | Excel Worksheet Functions |