Error Handling for Layout Changes

[reberryjr]

I've encountered an issue and I've been unable to find any literature on how to solve it. I'm importing about 30 source files into a single workbook. Of these, roughly 20 of them come from other areas of my company. I have zero control over them altering the layout of these source files, so I'm running into an issue where the code is either failing OR I'm getting incorrect results as a result of the layout change. Example: My code copies the date in column DN of the source file and pastes it into the destination workbook. Now that date is in column DO, so I'm getting incorrect results. Is there an efficient way to review the header text to ensure it equals "Date" and if so, proceed with the code. If the header text doesn't equal "Date"; find the header text that does equal "Date", and allow the code to continue with the new column position without manual intervention?

 

[mumps]

You can search for "Date" in row 1 of the source file to find its location. Can you use code tags to post a copy the macro you are currently using?

 

[reberryjr]

You can search for "Date" in row 1 of the source file to find its location. Can you use code tags to post a copy the macro you are currently using?

Here is a small snippet. I would imagine I would need to search row 1 for the desired text, but I have no idea how to incorporate the column the text is found in, into the code as the copy range.

With sD.Range("DN2:DN" & sDLR).SpecialCells(xlCellTypeVisible).Copy
    mD.Range("M" & mDLR + 1).PasteSpecial xlPasteValues
End With

 

[mumps]

Maybe:

Sub test()
    Application.ScreenUpdating = False
    Dim header As Range
    With sD
        Set fnd = .Rows(1).Find("Date", LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            .Range(.Cells(2, header.Column), .Cells(sDLR, header.Column)).SpecialCells(xlCellTypeVisible).Copy
            md.Cells(md.Rows.Count, "M").PasteSpecial xlPasteValues
        End If
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[reberryjr]

Maybe:

Sub test()
    Application.ScreenUpdating = False
    Dim header As Range
    With sD
        Set fnd = .Rows(1).Find("Date", LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            .Range(.Cells(2, header.Column), .Cells(sDLR, header.Column)).SpecialCells(xlCellTypeVisible).Copy
            md.Cells(md.Rows.Count, "M").PasteSpecial xlPasteValues
        End If
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

I assume fnd should be defined as a range. I'm getting an error at the below line:

With sD
    Set fnd = .Rows(1).Find("Date Review Completed", LookIn:=xlValues, LookAt:=xlWhole)
    If Not fnd Is Nothing Then
        .Range(.Cells(2, Hdr.Column), .Cells(sDLR, Hdr.Column)).SpecialCells(xlCellTypeVisible).Copy 'Object variable or with block not set.
        mD.Range("M" & mDLR + 1).PasteSpecial xlPasteValues
    End If
End With

 

[mumps]

My apologies.

Sub test()
    Application.ScreenUpdating = False
    Dim header As Range
    With sD
        Set header = .Rows(1).Find("Date", LookIn:=xlValues, lookat:=xlWhole)
        If Not header Is Nothing Then
            .Range(.Cells(2, header.Column), .Cells(sDLR, header.Column)).SpecialCells(xlCellTypeVisible).Copy
            md.Cells(md.Rows.Count, "M").PasteSpecial xlPasteValues
        End If
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[reberryjr]

My apologies.

Sub test()
    Application.ScreenUpdating = False
    Dim header As Range
    With sD
        Set header = .Rows(1).Find("Date", LookIn:=xlValues, lookat:=xlWhole)
        If Not header Is Nothing Then
            .Range(.Cells(2, header.Column), .Cells(sDLR, header.Column)).SpecialCells(xlCellTypeVisible).Copy
            md.Cells(md.Rows.Count, "M").PasteSpecial xlPasteValues
        End If
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

@mumps that works great! Thank you!

 

[mumps]

You are very welcome.

 

[reberryjr]

You are very welcome.

@mumps I'm trying to extrapolate the code you provided across other source files and I'm running into an issue. I'm trying to use this snippet, but it appears that if what I'm trying to find isn't all on the same line within the cell, I get an error. In the snippet below, "Find String" is in the header row, BUT it looks like someone pressed CTRL+ENTER to put "String" on a separate line. Is there a way to combat this?

With sD
    Set Hdr = .Rows(1).Find("Find String", LookIn:=xlValues, LookAt:=xlWhole)
    If Not Hdr Is Nothing Then
        .Range(.Cells(2, Hdr.Column), .Cells(sDLR, Hdr.Column)).SpecialCells(xlCellTypeVisible).Copy
        mD.Cells(mD.Rows.Count, "I").PasteSpecial xlPasteValues
    End If
End With

 

[mumps]

Is there a way to combat this?

Do you mean that you want it to find the string if "String" is on a separate line?