Macro Code Help

Z

zach9208

Board Regular
Joined
Dec 15, 2015
Messages
117
I am trying to set my macro file to remove formats from columns that have spaces in them (See CRMCleanup) I tried just adding a Call CRMCleanup piece of code to my UpdateHeadersCRM code but I keep getting an error saying the sheet is still protected. I need to cleanup or merge my code for the CRMCleanup code into the UpdateHeadersCRM code. Any ideas?


Code: 
Sub DoWork(wb As Workbook)    UpdateHeadersAspirational wb.Sheets("Apsirational") 'The template files have the tab "Aspirational" mispelled as "Apsirational"
    UpdateHeadersCRM wb.Sheets("CRM")


End Sub

Code: 
Sub ProcessFiles()Dim wb As Workbook
Dim Filename As String, Pathname As String


    Pathname = "C:\Users\c755748\Desktop\TEST2\" '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)
        DoWork wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop


End Sub


Code: 
Sub UpdateHeadersCRM(ws As Worksheet)

    With ws
        .Application.ScreenUpdating = False
        
        .Unprotect 'Unprotects the workbook
        .Range("A1:W3").Delete Shift:=xlUp 'Need to adjust range if a new column is added or removed
        
        'Re-names row 1 with the column names for the database. Update these fields if a new column is added or removed.
        .Range("A1").Value = "WGTD_SLS_CAL_AMT"
        .Range("B1").Value = "EST_RVNU_AMT"
        .Range("C1").Value = "EST_BPS_AMT"
        .Range("D1").Value = "WT_PRC"
        .Range("E1").Value = "AVG_BPS_AMT"
        .Range("F1").Value = "EST_FDNG_QTR_NM"
        .Range("G1").Value = "OPTY_NMBR"
        .Range("H1").Value = "CO_NM"
        .Range("I1").Value = "CNSLT_NM"
        .Range("J1").Value = "PRMY_PRDCT_NM"
        .Range("K1").Value = "BTQ_PRMY_PRDCT_TYP_NM"
        .Range("L1").Value = "INV_VHCL_2_NM"
        .Range("M1").Value = "PLNE_STP_NM"
        .Range("N1").Value = "RNKG_TYP_NM"
        .Range("O1").Value = "CRNCY_NM"
        .Range("P1").Value = "EST_MNDT_AMT"
        .Range("Q1").Value = "EST_MNDT_USD_AMT"
        .Range("R1").Value = "EST_DCSN_DT"
        .Range("S1").Value = "TM_MBR_NM"
        .Range("T1").Value = "RGN_4_NM"
        .Range("U1").Value = "OPTY_TYP_NM"
        .Range("V1").Value = "MOD_DT"
        .Range("W1").Value = "STAT_UPDT_TXT"


      Call CRMCleanup
    End With
    
End Sub

Code: 
Sub CRMCleanup() 'Need to adjust range if a new column is added or removed. This is needed in order to cleanup excess blank columns    
    Sheets("CRM").Unprotect
    Columns("X:AWY").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Clear
    
End Sub
 
Sort by date Sort by votes
Error reads: Run-time error '13'
Type mismatch

Debug shows the following line in red. I verified the tab in the file is labeled "CRM" so it is not a naming issue with the worksheet.

Code: 
Sub DoWork(wb As Workbook)    UpdateHeadersAspirational wb.Sheets("Apsirational") 'The template files have the tab "Aspirational" mispelled as "Apsirational"
[COLOR=#ff0000]    UpdateHeadersCRM wb.Sheets("CRM")[/COLOR]


End Sub


Fluff said:
What error did you get & what row is highlighted if you click debug?
Also what column can be used to find the last row of data?
Click to expand...
 
Upvote 0

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Try
Code: 
Call UpdateHeadersCRM[COLOR=#ff0000]2[/COLOR](wb.Sheets("CRM"))
Note, I have changed the name of the macro using the array, to avoid an Ambiguous name error.

I still need to know which column can be used to find the last row
 
Last edited:
Upvote 0
Column J would be the preferred column to base this off of.
Fluff said:
Try
Code: 
Call UpdateHeadersCRM[COLOR=#ff0000]2[/COLOR](wb.Sheets("CRM"))
Note, I have changed the name of the macro using the array, to avoid an Ambiguous name error.

I still need to know which column can be used to find the last row
Click to expand...
 
Upvote 0
Still get the error even after renaming. Here is the full code that I have in place.

Code: 
Sub ProcessFiles()Dim wb As Workbook
Dim Filename As String, Pathname As String


    Pathname = "C:\Users\c755748\Desktop\TEST2\" '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)
        DoWork wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop


End Sub


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


End Sub




Sub UpdateHeadersAspirational(Ws As Worksheet)


    With Ws
        .Application.ScreenUpdating = False
        .Unprotect 'Unprotects the workbook
        
        .Range("A1:H6").Delete Shift:=xlUp 'Need to adjust range if a new column is added or removed
        .Columns("A:B").Clear  'Need to delete these calculations since Access will be doing these.
        'Re-names row 1 with the column names for the database. Update these fields if a new column is added or removed.
        .Range("A1").Value = "EST_RVNU_USD_AMT"
        .Range("B1").Value = "EST_AVG_BPS_AMT"
        .Range("C1").Value = "EST_MNDT_USD_AMT"
        .Range("D1").Value = "FCAST_BTQ_NM"
        .Range("E1").Value = "INV_VHCL_NM"
        .Range("F1").Value = "EST_FDNG_QTR_NM"
        .Range("G1").Value = "AVG_BPS"
        .Range("H1").Value = "STAT_UPDT_TXT"
        .Columns("I:XFD").Clear
    End With
    
End Sub




   '.Columns("A:C").Clear  'Need to delete these calculations since Access will be doing these.


Sub UpdateHeadersCRM2(Ws As Worksheets)


    Dim Hdrs() As Variant
    Dim NxtRw As Long
    Dim Cnt As Long
    
    Hdrs = Array("WGTD_SLS_CAL_AMT", "EST_RVNU_AMT", "EST_BPS_AMT", "WT_PRC" _
            , "AVG_BPS_AMT", "EST_FDNG_QTR_NM", "OPTY_NMBR", "CO_NM", "CNSLT_NM" _
            , "PRMY_PRDCT_NM", "BTQ_PRMY_PRDCT_TYP_NM", "INV_VHCL_2_NM", "PLNE_STP_NM" _
            , "RNKG_TYP_NM", "CRNCY_NM", "EST_MNDT_AMT", "EST_MNDT_USD_AMT" _
            , "EST_DCSN_DT", "TM_MBR_NM", "RGN_4_NM", "OPTY_TYP_NM", "MOD_DT", "STAT_UPDT_TXT")
    
    With Ws
        .Application.ScreenUpdating = False
        
        .Unprotect 'Unprotects the workbook


        .Range("A1").Resize(3, 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 = .Cells.Find("*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Offset(1).Row
        .Range("A" & NxtRw, "A" & Rows.Count).Clear


    End With
    
End Sub
 
Upvote 0
In that case use this in either macro
Code: 
        NxtRw = .Range("J" & Rows.Count).End(xlUp).Row
 
Upvote 0
Got it. this
Code: 
Sub UpdateHeadersCRM2(Ws As Worksheets)
Should be
Code: 
Sub UpdateHeadersCRM2(Ws As Worksheet)
So the whole sub is now
Code: 
Sub UpdateHeadersCRM2(Ws As Worksheet)


    Dim Hdrs() As Variant
    Dim NxtRw As Long
    Dim NxtCol As Long
    Dim Cnt As Long
    
    Hdrs = Array("WGTD_SLS_CAL_AMT", "EST_RVNU_AMT", "EST_BPS_AMT", "WT_PRC" _
            , "AVG_BPS_AMT", "EST_FDNG_QTR_NM", "OPTY_NMBR", "CO_NM", "CNSLT_NM" _
            , "PRMY_PRDCT_NM", "BTQ_PRMY_PRDCT_TYP_NM", "INV_VHCL_2_NM", "PLNE_STP_NM" _
            , "RNKG_TYP_NM", "CRNCY_NM", "EST_MNDT_AMT", "EST_MNDT_USD_AMT" _
            , "EST_DCSN_DT", "TM_MBR_NM", "RGN_4_NM", "OPTY_TYP_NM", "MOD_DT", "STAT_UPDT_TXT")
    
    With Ws
        .Application.ScreenUpdating = False
        
        .Unprotect 'Unprotects the workbook


        .Range("A1").Resize(3, CInt(UBound(Hdrs)) + 1).Delete Shift:=xlUp
        
        For Cnt = 0 To UBound(Hdrs)
            .Cells(1, Cnt + 1) = Hdrs(Cnt)
         Next Cnt

        NxtCol = .Columns(Columns.Count).End(xlToLeft).Offset(, 1).Column
        .Columns(NxtCol).Resize(, Columns.Count - NxtCol + 1).Clear
        NxtRw = .Range("J" & Rows.Count).End(xlUp).Row
        .Range("A" & NxtRw, "A" & Rows.Count).Clear

    End With
    
End Sub
 
Last edited:
Upvote 0
Still getting the same error.

Code: 
Sub DoWork(wb As Workbook)    UpdateHeadersAspirational wb.Sheets("Apsirational") 'The template files have the tab "Aspirational" mispelled as "Apsirational". This will be eventually fixed in the template files.
    UpdateHeadersCRM2 wb.Sheets("CRM")


End Sub


Code: 
Sub UpdateHeadersCRM2(Ws As Worksheets)

    Dim Hdrs() As Variant
    Dim NxtRw As Long
    Dim Cnt As Long
    
    Hdrs = Array("WGTD_SLS_CAL_AMT", "EST_RVNU_AMT", "EST_BPS_AMT", "WT_PRC" _
            , "AVG_BPS_AMT", "EST_FDNG_QTR_NM", "OPTY_NMBR", "CO_NM", "CNSLT_NM" _
            , "PRMY_PRDCT_NM", "BTQ_PRMY_PRDCT_TYP_NM", "INV_VHCL_2_NM", "PLNE_STP_NM" _
            , "RNKG_TYP_NM", "CRNCY_NM", "EST_MNDT_AMT", "EST_MNDT_USD_AMT" _
            , "EST_DCSN_DT", "TM_MBR_NM", "RGN_4_NM", "OPTY_TYP_NM", "MOD_DT", "STAT_UPDT_TXT")
    
    With Ws
        .Application.ScreenUpdating = False
        
        .Unprotect 'Unprotects the workbook


        .Range("A1").Resize(3, 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("J" & Rows.Count).End(xlUp).Row
        'NxtRw = .Cells.Find("*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Offset(1).Row
        .Range("A" & NxtRw, "A" & Rows.Count).Clear


    End With
    
End Sub

Fluff said:
In that case use this in either macro
Code: 
        NxtRw = .Range("J" & Rows.Count).End(xlUp).Row
Click to expand...
 
Upvote 0
Figured it out!!! There should not be an "s" on the worksheet.

Your code: Sub UpdateHeadersCRM2(Ws As Worksheets)
Working Code: Sub UpdateHeadersCRM2(Ws As Worksheet)


zach9208 said:
Still getting the same error.

Code: 
Sub DoWork(wb As Workbook)    UpdateHeadersAspirational wb.Sheets("Apsirational") 'The template files have the tab "Aspirational" mispelled as "Apsirational". This will be eventually fixed in the template files.
    UpdateHeadersCRM2 wb.Sheets("CRM")


End Sub


Code: 
Sub UpdateHeadersCRM2(Ws As Worksheets)

    Dim Hdrs() As Variant
    Dim NxtRw As Long
    Dim Cnt As Long
    
    Hdrs = Array("WGTD_SLS_CAL_AMT", "EST_RVNU_AMT", "EST_BPS_AMT", "WT_PRC" _
            , "AVG_BPS_AMT", "EST_FDNG_QTR_NM", "OPTY_NMBR", "CO_NM", "CNSLT_NM" _
            , "PRMY_PRDCT_NM", "BTQ_PRMY_PRDCT_TYP_NM", "INV_VHCL_2_NM", "PLNE_STP_NM" _
            , "RNKG_TYP_NM", "CRNCY_NM", "EST_MNDT_AMT", "EST_MNDT_USD_AMT" _
            , "EST_DCSN_DT", "TM_MBR_NM", "RGN_4_NM", "OPTY_TYP_NM", "MOD_DT", "STAT_UPDT_TXT")
    
    With Ws
        .Application.ScreenUpdating = False
        
        .Unprotect 'Unprotects the workbook


        .Range("A1").Resize(3, 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("J" & Rows.Count).End(xlUp).Row
        'NxtRw = .Cells.Find("*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Offset(1).Row
        .Range("A" & NxtRw, "A" & Rows.Count).Clear


    End With
    
End Sub
Click to expand...
 
Upvote 0
Even though I got the macro to run successfully, it still is not clearing all on the rows below the last cell with data in column J. Is it possible for the macro to select the next row after the last data was entered and then select the range all the way to the bottom of the workbook, then clear? It seems like the loop is not working as intended.
 
Upvote 0
If you select J1 & do Ctrl + down arrow does that take you to the last row of data?
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Value not shown in ComboBox1 when code run
Replies
1
Views
37
ipbr21054
I
I
  • Solved
Simplify my working code please
Replies
7
Views
127
ipbr21054
I
I
  • Solved
Code moves worksheets columns to the left thus not showing column A
Replies
5
Views
191
Peter_SSs
Peter_SSs
B
  • Question Question
Excel VBA Searching Unique Variables to Match against Exported Schedule Files to Determine Date
Replies
1
Views
125
sijpie
sijpie
I
  • Question Question
Making code easier to work with at start of new tax year
Replies
2
Views
162
ipbr21054
I

Forum statistics

Threads
1,223,248
Messages
6,171,011
Members
452,374
Latest member
keccles

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top