Help Debug Issue with Macro Code

[zach9208]

I am using the below code to cleanup a bunch of workbooks. I came across a workbook that does not have any data inputted below row 1. Row 1 contains the headers. The macro keeps throwing the generic error "Run-time '1004': Application-defined or object-defined error". Clicking the debug issue reveals that the issue is related to the following line

NxtRw = .Range("E1").End(xlDown).Offset(1).Row

I think this must be relating to the sheet not having any data below row 1. Any ideas what I can do to remedy this error? I am clearly a novice when it comes to VBA!

Sub UpdateHeadersAspirationalInstitutional(Ws As Worksheet)

    Dim Hdrs() As Variant
    Dim NxtRw As Long
    Dim Cnt As Long
    Dim LastRow As Long
    
    LastRow = Range("C" & Rows.Count).End(xlUp).Row


    Hdrs = Array("ANULZ_RVNU_AMT", "CALC_BPS_AMT", "EST_MNDT_USD_AMT", "BTQ_NM" _
    , "MJR_INV_VHCL_NM", "EST_FDNG_QTR_NM", "SLS_PSN_AVG_BPS_AMT", "STAT_UPDT_TXT", "SRCE_NM", "TM_MBR_NM") 'Sets column names for Aspirational tab. Need to adjust this if a new column is added or removed.


    With Ws
        
        .Application.ScreenUpdating = False


        .Unprotect 'Unprotects the workbook
        
        .Range("A1").Resize(5, CInt(UBound(Hdrs)) + 1).Delete Shift:=xlUp
        
    For Cnt = 0 To UBound(Hdrs)
            .Cells(1, Cnt + 1) = Hdrs(Cnt)
         Next Cnt




        .Columns(UBound(Hdrs) + 2).Resize(, 16383 - UBound(Hdrs)).Clear
          NxtRw = .Range("E1").End(xlDown).Offset(1).Row
        .Range("A" & NxtRw, "A" & Rows.Count).EntireRow.Clear
        .Range("I2:I" & LastRow).Formula = _
            "=MID(CELL(""filename"",A1),FIND(""]"",CELL(""filename"",A1))+1,256)" 'Adds SRCE_NM column based on the workbook name since this is not included as a column name in this file.
        
        .Range("J2:J" & LastRow).Formula = "=CRM!$S$5" 'Adds TM_MBR_NM column based on the TM_MBR_NM from the CRM tab
    End With


    End Sub

 

[Fluff]

Try

NxtRw = .Range("E1").End(xlUp).Offset(1).Row

 

[NARAYANK991]

Hi ,

See if this works :

Sub UpdateHeadersAspirationalInstitutional(Ws As Worksheet)
    Dim Hdrs() As Variant
    Dim NxtRw As Long
    Dim Cnt As Long
    Dim LastRow As Long
    
    LastRow = Range("C" & Rows.Count).End(xlUp).Row


    Hdrs = Array("ANULZ_RVNU_AMT", "CALC_BPS_AMT", "EST_MNDT_USD_AMT", "BTQ_NM" _
    , "MJR_INV_VHCL_NM", "EST_FDNG_QTR_NM", "SLS_PSN_AVG_BPS_AMT", "STAT_UPDT_TXT", "SRCE_NM", "TM_MBR_NM") 'Sets column names for Aspirational tab. Need to adjust this if a new column is added or removed.


    With Ws
        .Application.ScreenUpdating = False
        .Unprotect 'Unprotects the workbook
        .Range("A1").Resize(5, CInt(UBound(Hdrs)) + 1).Delete Shift:=xlUp


        For Cnt = 0 To UBound(Hdrs)
            .Cells(1, Cnt + 1) = Hdrs(Cnt)
        Next Cnt


        .Columns(UBound(Hdrs) + 2).Resize(, 16383 - UBound(Hdrs)).Clear
        If .Range("E2") <> vbNullString Then
           NxtRw = .Range("E1").End(xlDown).Offset(1).Row
           .Range("A" & NxtRw, "A" & Rows.Count).EntireRow.Clear
           .Range("I2:I" & LastRow).Formula = _
            "=MID(CELL(""filename"",A1),FIND(""]"",CELL(""filename"",A1))+1,256)" 'Adds SRCE_NM column based on the workbook name since this is not included as a column name in this file.
        
           .Range("J2:J" & LastRow).Formula = "=CRM!$S$5" 'Adds TM_MBR_NM column based on the TM_MBR_NM from the CRM tab
        End If
    End With
End Sub

 

[zach9208]

So I tried both suggestions. The xlup replacement caused all of the data to disappear. I think the

[COLOR=#333333]If .Range("E2") <> vbNullString then [/COLOR][COLOR=#333333]NxtRw = .Range("E1").End(xlDown).Offset(1).Row [/COLOR][COLOR=#333333]End

statement[/COLOR] may have solved the problem. I need to do some more testing to be sure. I'll keep you posted. Thank you both for the quick responses!

 

[zach9208]

So now I am having issues with my code that is copying down formulas. It seems to be working inconsistently. I need columns I and J to copy down formulas only if there is data starting in row 2.

For some reason this pulls down the data further. I think I have the code referencing to use column D but it something is causing it to not work properly.

.Range("I2:I" & LastRow).Formula = _
            "=MID(CELL(""filename"",$A$1),FIND(""]"",CELL(""filename"",$A$1))+1,256)" 'Adds SRCE_NM column based on the workbook name since this is not included as a column name in this file.
        .Range("J2:J" & LastRow).Formula = "=CRM!$S$5" 'Adds TM_MBR_NM column based on the TM_MBR_NM from the CRM tab

Sub UpdateHeadersAspirationalInstitutional(Ws As Worksheet)


    Dim Hdrs() As Variant
    Dim NxtRw As Long
    Dim Cnt As Long
    Dim LastRow As Long
    
    LastRow = Range("D" & Rows.Count).End(xlUp).Row


    Hdrs = Array("ANULZ_RVNU_AMT", "CALC_BPS_AMT", "EST_MNDT_USD_AMT", "BTQ_NM" _
    , "MJR_INV_VHCL_NM", "EST_FDNG_QTR_NM", "SLS_PSN_AVG_BPS_AMT", "STAT_UPDT_TXT", "SRCE_NM", "TM_MBR_NM") 'Sets column names for Aspirational tab. Need to adjust this if a new column is added or removed.


    With Ws
        
        .Application.ScreenUpdating = False 'Turns off screen updating
        .Unprotect 'Unprotects the workbook
        
        .Range("A1").Resize(5, CInt(UBound(Hdrs)) + 1).Delete Shift:=xlUp 'Deletes first 5 rows at the top of the Aspirational tab
        
        .Range("I2:I" & LastRow).Formula = _
            "=MID(CELL(""filename"",$A$1),FIND(""]"",CELL(""filename"",$A$1))+1,256)" 'Adds SRCE_NM column based on the workbook name since this is not included as a column name in this file.
        .Range("J2:J" & LastRow).Formula = "=CRM!$S$5" 'Adds TM_MBR_NM column based on the TM_MBR_NM from the CRM tab
        
    For Cnt = 0 To UBound(Hdrs)
            .Cells(1, Cnt + 1) = Hdrs(Cnt)
         Next Cnt


        .Columns(UBound(Hdrs) + 2).Resize(, 16383 - UBound(Hdrs)).Clear
        
        If .Range("D2") <> vbNullString Then
           NxtRw = .Range("D1").End(xlDown).Offset(1).Row
           .Range("A" & NxtRw, "A" & Rows.Count).EntireRow.Clear
       
        End If
        
        
    End With
End Sub

 

[Norie]

Try moving the code to find the last row within the With...End With block.

Sub UpdateHeadersAspirationalInstitutional(Ws As Worksheet)
Dim Hdrs() As Variant
Dim NxtRw As Long
Dim Cnt As Long
Dim LastRow As Long

    Hdrs = Array("ANULZ_RVNU_AMT", "CALC_BPS_AMT", "EST_MNDT_USD_AMT", "BTQ_NM" _
                , "MJR_INV_VHCL_NM", "EST_FDNG_QTR_NM", "SLS_PSN_AVG_BPS_AMT", "STAT_UPDT_TXT", "SRCE_NM", "TM_MBR_NM")    'Sets column names for Aspirational tab. Need to adjust this if a new column is added or removed.


    With Ws

        .Application.ScreenUpdating = False    'Turns off screen updating
        .Unprotect    'Unprotects the workbook
        
        .Range("A1").Resize(5, CInt(UBound(Hdrs)) + 1).Delete Shift:=xlUp    'Deletes first 5 rows at the top of the Aspirational tab
        
        LastRow = .Range("D" & Rows.Count).End(xlUp).Row

        .Range("I2:I" & LastRow).Formula = _
        "=MID(CELL(""filename"",$A$1),FIND(""]"",CELL(""filename"",$A$1))+1,256)"    'Adds SRCE_NM column based on the workbook name since this is not included as a column name in this file.
        .Range("J2:J" & LastRow).Formula = "=CRM!$S$5"    'Adds TM_MBR_NM column based on the TM_MBR_NM from the CRM tab

        .Cells(1, 1).Resize(, UBound(Hdrs) + 1).Value = Hdrs

        .Columns(UBound(Hdrs) + 2).Resize(, 16383 - UBound(Hdrs)).Clear

        If .Range("D2") <> vbNullString Then
            NxtRw = .Range("D1").End(xlDown).Offset(1).Row
            .Range("A" & NxtRw, "A" & Rows.Count).EntireRow.Clear

        End If

    End With
    
End Sub

 

[zach9208]

I tried moving this to the With block and still getting mixed results.

More background. I am running the following code to cleanup 30+ template files that share the same formatting and have different amounts of data(rows). I am seeing some templates that get the TM_MBR_NM and SRCE_NM copied down to the correct spot and then the macro cleans up the formatting to remove extra rows that have no data.

There are other examples where the whole tab does not have any data after the headers are added and it seems to keep copying down the these two columns regardless of column D having no data. In addition, the macro does not appear to be clearing out the extra formatting below row 1 when there is no data. Note all of these templates have cell highlighting through line 87 for the aspirational tab and 103 for the CRM tab. Surely this is not causing the problem!

Lastly, there are some examples where there is data below the headers and the macro copies down these formulas down and then stops in a random spot even though there are more rows with data. I am detecting the Long Range with Column D and confirmed that there is data going all the way down the data with no gaps. It is super weird how it just stops. Maybe I just made my code too choppy or the macro is running to quickly? I am getting desperate for help, I have to get this working! It seems like I tried everything to try and remedy the issues. Here is the full code I am running on each of the templates, maybe you will spot the cause

''INSTITUIONAL CODE BEGINS HERE''

Sub ProcessAspirationalFiles()
Dim wb As Workbook
Dim Filename As String, Pathname As String


    Pathname = "C:\Users\c755748\Desktop\Institutional Templates\" 'This is the file path the templates need saved to in order for the macro to clean the file formats up in prep for the database
    Filename = Dir(Pathname & "*.xlsx")


    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        InstituitonalTabs wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop


End Sub


Sub InstituitonalTabs(wb As Workbook)
    UpdateHeadersAspirationalInstitutional wb.Sheets("Apsirational") 'The template files have the tab "Aspirational" mispelled as "Apsirational". This will be eventually fixed in the template files.
    UpdateHeadersCRM wb.Sheets("CRM")


End Sub


Sub UpdateHeadersAspirationalInstitutional(Ws As Worksheet)


    Dim Hdrs() As Variant
    Dim NxtRw As Long
    Dim Cnt As Long
    Dim LastRow As Long
    
    LastRow = Range("D" & Rows.Count).End(xlUp).Row


    Hdrs = Array("ANULZ_RVNU_AMT", "CALC_BPS_AMT", "EST_MNDT_USD_AMT", "BTQ_NM" _
    , "MJR_INV_VHCL_NM", "EST_FDNG_QTR_NM", "SLS_PSN_AVG_BPS_AMT", "STAT_UPDT_TXT", "SRCE_NM", "TM_MBR_NM") 'Sets column names for Aspirational tab. Need to adjust this if a new column is added or removed.


    With Ws
        
        .Application.ScreenUpdating = False 'Turns off screen updating
        .Unprotect 'Unprotects the workbook
        
        .Range("A1").Resize(5, CInt(UBound(Hdrs)) + 1).Delete Shift:=xlUp 'Deletes first 5 rows at the top of the Aspirational tab
        
        .Range("I2:I" & LastRow).Formula = _
            "=MID(CELL(""filename"",$A$1),FIND(""]"",CELL(""filename"",$A$1))+1,256)" 'Adds SRCE_NM column based on the workbook name since this is not included as a column name in this file.
        .Range("J2:J" & LastRow).Formula = "=CRM!$S$5" 'Adds TM_MBR_NM column based on the TM_MBR_NM from the CRM tab
        
    For Cnt = 0 To UBound(Hdrs)
            .Cells(1, Cnt + 1) = Hdrs(Cnt)
         Next Cnt


        .Columns(UBound(Hdrs) + 2).Resize(, 16383 - UBound(Hdrs)).Clear
        
        If .Range("D2") <> vbNullString Then
           NxtRw = .Range("D1").End(xlDown).Offset(1).Row
           .Range("A" & NxtRw, "A" & Rows.Count).EntireRow.Clear
       
        End If
        
        
    End With
End Sub


Sub UpdateHeadersCRM(Ws As Worksheet)


    Dim Hdrs() As Variant
    Dim NxtRw As Long
    Dim Cnt As Long
    Dim LastRow As Long
    
    Hdrs = Array("WGTD_SLS_CAL_AMT", "ANULZ_RVNU_AMT", "CALC_BPS_AMT", "FDNG_PRBL_PCT_AMT" _
            , "SLS_PSN_AVG_BPS_AMT", "EST_FDNG_QTR_NM", "OPTY_NMBR", "CO_NM", "CNSLT_NM" _
            , "PRMY_PRDCT_NM", "BTQ_NM", "INV_VHCL_NM", "PLNE_STP_NM" _
            , "RNKG_TYP_NM", "CRNCY_NM", "EST_MNDT_CRNCY_AMT", "EST_MNDT_USD_AMT" _
            , "EST_DCSN_DT", "TM_MBR_NM", "RGN_NM", "OPTY_TYP_NM", "MOD_DT", "STAT_UPDT_TXT", "SRCE_NM") 'Sets column names for CRM tab. Need to adjust this if a new column is added or removed.
    
    With Ws
        .Application.ScreenUpdating = False
        
        .Unprotect 'Unprotects the workbook


        LastRow = Range("G" & Rows.Count).End(xlUp).Row
        
        .Range("A1").Resize(3, CInt(UBound(Hdrs)) + 1).Delete Shift:=xlUp
        
        .Range("X2:X" & LastRow).Formula = _
        "=MID(CELL(""filename"",$A$1),FIND(""]"",CELL(""filename"",$A$1))+1,256)"
        
        For Cnt = 0 To UBound(Hdrs)
            .Cells(1, Cnt + 1) = Hdrs(Cnt)
         Next Cnt


        .Columns(UBound(Hdrs) + 2).Resize(, 16383 - UBound(Hdrs)).Clear
        If .Range("G2") <> vbNullString Then
           NxtRw = .Range("G1").End(xlDown).Offset(1).Row
           .Range("A" & NxtRw, "A" & Rows.Count).EntireRow.Clear
        End If
    End With
End Sub
''INSTITUIONAL CODE ENDS HERE''

 

[Norie]

You are missing a . in front of Range here.

[
    With Ws
        .Application.ScreenUpdating = False
        
        .Unprotect 'Unprotects the workbook

        LastRow = Range("G" & Rows.Count).End(xlUp).Row

Without the . Range will refer to the active sheet, not the sheet in the With part of the code.

 

[zach9208]

Thank you so much, Nori! This fixed the copy down formula issue!!!! The only item that is left is that I need the Apsirational to clear rows when there is no data below row 1. The macro seems to be cleaning up/ deleting rows with excess formatting that do not have any data when there is at least one row of data present in the template (which is what I want to happen). However, when a template has no data aside from the headers (so no data in row 2), it seems to not delete the extra formatted rows that contain no data. Is there anything I can do to make the macro cleanup up those templates that have no data starting in row 2 of the Apsirational tab? I need these lines to be truly cleared out since my Access macro seems to pull in lines that are blank. Any ideas? Could a If statement maybe work? the cleanup part of the code was is the part I really cannot comprehend.

Here is the Access VBA code that I am using in Access in case your curious or if it would be better to build in a piece of code to ignore these blank rows.

Public Sub PullInstitutionalTemplateData()Dim strPathFile As String, strFile As String, strPath As String
 Dim blnHasFieldNames As Boolean
 Dim intWorksheets As Integer


' Replace 3 with the number of worksheets to be imported
 ' from each EXCEL file
 Dim strWorksheets(1 To 2) As String


' Replace 3 with the number of worksheets to be imported
 ' from each EXCEL file (this code assumes that each worksheet
 ' with the same name is being imported into a separate table
 ' for that specific worksheet name)
 Dim strTables(1 To 2) As String


' Replace generic worksheet names with the real worksheet names;
 ' add / delete code lines so that there is one code line for
 ' each worksheet that is to be imported from each workbook file
 strWorksheets(1) = "Apsirational"
 strWorksheets(2) = "CRM"
 
' Replace generic table names with the real table names;
 ' add / delete code lines so that there is one code line for
 ' each worksheet that is to be imported from each workbook file
 strTables(1) = "1-tblForecastStaging"
 strTables(2) = "1-tblForecastStaging"




' Change this next line to True if the first row in EXCEL worksheet
 ' has field names
 blnHasFieldNames = True


' Replace C:\Documents\ with the real path to the folder that
 ' contains the EXCEL files
 strPath = "C:\Users\c755748\Desktop\Institutional Templates\"


' Replace 3 with the number of worksheets to be imported
 ' from each EXCEL file
 For intWorksheets = 1 To 2


       strFile = Dir(strPath & "*.xls")
       Do While Len(strFile) > 0
             strPathFile = strPath & strFile
             DoCmd.TransferSpreadsheet acImport, _
                   acSpreadsheetTypeExcel9, strTables(intWorksheets), _
                   strPathFile, blnHasFieldNames, _
                   strWorksheets(intWorksheets) & "$"
             strFile = Dir()
       Loop


 Next intWorksheets


End Sub

You are missing a . in front of Range here.

[
    With Ws
        .Application.ScreenUpdating = False
        
        .Unprotect 'Unprotects the workbook

        LastRow = Range("G" & Rows.Count).End(xlUp).Row

Without the . Range will refer to the active sheet, not the sheet in the With part of the code.