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

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/

.

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