View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
teyhuiyi[_2_] teyhuiyi[_2_] is offline
external usenet poster
 
Posts: 1
Default 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