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
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 WorksheetDim TargetLR As Long, TargetLC As Long, SourceLR As Long, SourceLC As Long, zl As LongDim FolderPath As String, Filter As String, Caption As String, SourceFName As VariantDim SourceWB As Workbook, TargetWB As WorkbookDim ClearRng As Range, CopyRng As RangeFolderPath = Application.ThisWorkbook.PathChDir FolderPathFilter = "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 SubElseSet 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 IfEnd Sub