Flora Edwards
asked on
how to update this VBA so that it checks the new data columns against old data columns?
I have this code below.
it imports the selected worksheet into Target worksheet called "Maria Hospital"
now the number of columns with data and their order and also header names of the existing data in the target worksheet and the new imported file must match. if any of them do not match. macro should pop a message box stating which column header or order changed, or if new column added.
how can this code be modified, that before clearing the target old data via this line
The macro should do a cross examination of columns between the existing data and the new data that is to be imported and if column header or order of columns changed, or if new column added to the end of data. it should pop a message box.
thanks.
it imports the selected worksheet into Target worksheet called "Maria Hospital"
now the number of columns with data and their order and also header names of the existing data in the target worksheet and the new imported file must match. if any of them do not match. macro should pop a message box stating which column header or order changed, or if new column added.
how can this code be modified, that before clearing the target old data via this line
If Not IsEmpty(ClearRng) = True Then
ClearRng.ClearContents
End If
The macro should do a cross examination of columns between the existing data and the new data that is to be imported and if column header or order of columns changed, or if new column added to the end of data. it should pop a message box.
thanks.
Sub UpdatefromFileofOracle()
Dim TargetWs As Worksheet, SourceWs As Worksheet
Dim TargetLR As Long, TargetLC As Long, SourceLR As Long, SourceLC As Long, zl As Long
Dim FolderPath As String, Filter As String, Caption As String, SourceFName As Variant
Dim SourceWB As Workbook, TargetWB As Workbook
Dim ClearRng As Range, CopyRng As Range
FolderPath = Application.ThisWorkbook.Path
ChDir FolderPath
Filter = "Excel files (*.xl*),*.xl*"
Caption = "Please Browse & Select the downloaded File "
SourceFName = Application.GetOpenFilename(Filter, , Caption)
If SourceFName = False Then
MsgBox "You have CANCELLED selection of needed FILE", vbCritical, "- FOLLOW INSTRUCTION"
Exit Sub
Else
Set SourceWB = Application.Workbooks.Open(SourceFName, Format:=xlDelimited, Local:=True)
'Disable Events
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.DisplayStatusBar = True
.StatusBar = "!!! Please Be Patient...Updating Records !!!"
.EnableEvents = False
.Calculation = xlManual
End With
'Clear Old Data
Set TargetWB = Application.ThisWorkbook
Set TargetWs = TargetWB.Worksheets("Maria Hospital")
TargetLR = TargetWs.Range("A1").SpecialCells(xlCellTypeLastCell).Row
TargetLC = TargetWs.Range("A1").SpecialCells(xlCellTypeLastCell).Column
Set ClearRng = TargetWs.Range(TargetWs.Range("A1"), TargetWs.Cells(TargetLR, TargetLC))
If Not IsEmpty(ClearRng) = True Then
ClearRng.ClearContents
End If
'Copy Data From Source Workbook
Set lo = Nothing
For zl = 1 To SourceWB.Sheets.Count
Set SourceWs = SourceWB.Sheets(zl)
If SourceWs.Visible Then Exit For
Next
On Error Resume Next
Set lo = SourceWs.ListObjects(1)
On Error GoTo 0
If Not lo Is Nothing Then
Set CopyRng = lo.Range
Else
SourceLR = SourceWs.Range("A1").SpecialCells(xlCellTypeLastCell).Row
SourceLC = SourceWs.Range("A1").SpecialCells(xlCellTypeLastCell).Column
Set CopyRng = SourceWs.Range(SourceWs.Range("A1"), SourceWs.Cells(SourceLR, SourceLC))
End If
CopyRng.Copy
TargetWs.Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False
' Close Source Workbook
Application.DisplayAlerts = False
SourceWB.Close SaveChanges:=False
TargetWs.Activate
TargetWs.Columns.AutoFit
TargetWs.Rows.AutoFit
TargetWs.Cells.WrapText = False
On Error Resume Next
TargetWs.ListObjects(1).Unlist
On Error GoTo 0
TargetWs.Range("A1").Select
'Enable Events
With Application
.DisplayAlerts = False
.ScreenUpdating = True
.DisplayStatusBar = True
.StatusBar = False
.EnableEvents = True
.Calculation = xlAutomatic
End With
MsgBox "!!! File Import Is Completed Now !!!"
End If
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER