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 is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
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

O
  • Question
Multiple VBA codes on sheet1
Replies
1
Views
189
skillilea
S
Chris_010101
  • Solved
Simple VBA Code help
2
Replies
12
Views
547
Chris_010101
Chris_010101
U
  • Solved
Filename Saving Questions
Replies
8
Views
356
ummjay
U
S
  • Question
VBA Code - Create Log sheet (Errorlog) in case VBA Macro condition is not met
Replies
1
Views
198
Tupe77
T
M
  • Question
Help making my VBA code apply to only one column
Replies
2
Views
131
Alex Blakenburg
A

Forum statistics

Threads
1,216,028
Messages
6,128,393
Members
449,446
Latest member
CodeCybear

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