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/

.