Help needed on vba modification on earlier solution

Hi,

pls try

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
Dim HeadersMatch

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
    
    ' Select source worksheet
    For zl = 1 To SourceWB.Sheets.count
        Set SourceWs = SourceWB.Sheets(zl)
        If SourceWs.Visible Then Exit For
    Next
    
    '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
    
    ' Make sure headers match
    SourceLR = SourceWs.Range("A1").SpecialCells(xlCellTypeLastCell).Row
    SourceLC = SourceWs.Range("A1").SpecialCells(xlCellTypeLastCell).Column
    HeadersMatch = ""
    If WorksheetFunction.CountA(TargetWs.Cells) > 0 Then
        Set rngFind = Nothing
        Set rngFind = TargetWs.Range("1:1").Find("Hospitals")
        If Not rngFind Is Nothing Then rngFind.EntireColumn.Delet

        If TargetLC = SourceLC Then
            For i = 1 To TargetLC
                If TargetWs.Cells(1, i).Value <> SourceWs.Cells(1, i).Value Then
                    HeadersMatch = "Header column mismatch at column = " & i & "exiting = " & TargetWs.Cells(1, i).Value & ", import = " & SourceWs.Cells(1, i).Value
                    Exit For
                End If
            Next
        Else
            HeadersMatch = "Header column count differs, existing count = " & SourceLC & ", import count = " & TargetLC
        End If
    End If
    If HeadersMatch <> "" Then
        MsgBox "Headers in import file do not match existing data, can not import." & vbCrLf & cbCrLf & HeadersMatch
        SourceWB.Close SaveChanges:=False
        With Application
            .DisplayAlerts = False
            .ScreenUpdating = True
            .DisplayStatusBar = True
            .StatusBar = False
            .EnableEvents = True
            .Calculation = xlAutomatic
        End With
        Exit Sub
    End If
    
    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
  
    On Error Resume Next
    Set lo = SourceWs.ListObjects(1)
    On Error GoTo 0
    If Not lo Is Nothing Then
        Set CopyRng = lo.Range
    Else
        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

Select allOpen in new window

Regards

thanks Rgonzo1971.

it does delete that new column, but then it gives me the attached error, even though the number of columns are in both sheets 83 but somehow counts it double


i have also attached both source file and target file.
Target-file.xlsb
source-file.xlsx

Source file has 136 cols

there is something wrong with the code.  for the first attempt it works. but on the next one. it duplicates the data by columns.

i am trying to figure out what is causing this.

Rgonzo1971.

with a smaller data set. i recorded a video.
Recorded.mp4
Target-file.xlsb
source.xlsx

i think , we are getting close.

i put this into the code after Debug.Print TargetLC  and for the first time, it counts 4 and the next run it counts 5

i think the line TargetLC = TargetWs.Range("A1").SpecialCells(xlCellTypeLastCell).Column    counts columns based on usedrange and even after the deletion of the column created as Hospitals the usedrange does not get reset.

how can i reset the used range here?

Thank you very much

i posted a follow up question to learn about the use of last column or row method.

https://www.experts-exchange.com/questions/29071759/what-should-be-the-best-correct-option-to-use-SpecialCells-xlCellTypeLastCell-or-Find-or-rows-count.html