Consulting

Results 1 to 16 of 16

Thread: Changing Column Headers

  1. #1
    VBAX Regular
    Joined
    Nov 2019
    Posts
    7
    Location

    Changing Column Headers

    This Excel VBA Code, shown below was previously posted in 2016 and it worked, but now it doesn't. The column headers are all renamed and then I get this error: "Object Variable or With block variable not set". Debug highlights the row which is shown in BOLD. I'm not sure where to look?

    Sub ChangeColumnHeaders()
    'ONE  - This sub renames all of the column headers from NSS that are applicable to the access import AND
    'Inserts all additional columns and names the column headers
    
    
      
        Dim ColHeads
        Dim i As Long
    
    
        Sheets("Shelter").Select
        ColHeads = Worksheets("Column_Headers").Cells(1).CurrentRegion.Value
    
    
        With Worksheets("Shelter")
            For i = LBound(ColHeads, 1) To UBound(ColHeads, 1)
                .Rows(1).Find(ColHeads(i, 1)).Value = ColHeads(i, 2)
           
            Next i
        End With
        
    
    
        'Insert Column to the left of Column D 'SSecondaryPhoneType to the right of SSecondary Phone
        Columns("E:E").Insert Shift:=xlToRight, _
        CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
        Worksheets("Shelter").Range("E1").Value = "SSecondaryPhoneType"
    
    
        'Insert Column to the left of Column Z 'CPrimaryPhoneType to the right of CPrimaryPhoneExt
        Columns("Z:Z").Insert Shift:=xlToRight, _
        CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
        Worksheets("Shelter").Range("Z1").Value = "CPrimaryPhoneType"
    
    
    
    
        'Insert 2 Columns to the left of Column AB1 & AC1 ''CAlternatePhoneType to the right of CAlernatePhone
        Columns("AB:AC").Insert Shift:=xlToRight, _
        CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
        Worksheets("Shelter").Range("AB1").Value = "CAlternatePhoneType"
        Worksheets("Shelter").Range("AC1").Value = "CAlternatePhoneExt"
    
    
        'Insert 1 Columns to the left of Column AJ1 '
        Columns("AJ:AJ").Insert Shift:=xlToRight, _
        CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
        Worksheets("Shelter").Range("AJ1").Value = "24HrPOCPhoneType"
    
    
    
    
       'Insert 1 Columns to the left of Column AQ1
        Columns("AQ:AQ").Insert Shift:=xlToRight, _
        CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
        Worksheets("Shelter").Range("AQ1").Value = "AlternateContact1PhoneType"
    
    
    
    
        'Insert 1 Columns to the left of Column AX1
        Columns("AX:AX").Insert Shift:=xlToRight, _
        CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
        Worksheets("Shelter").Range("AX1").Value = "AlternateContact2PhoneType"
    
    
    Call RemovePhoneDashes
    End Sub 'Change_and_Rename_Headers_
    Last edited by Paul_Hossler; 11-18-2019 at 07:44 AM.

  2. #2
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,809
    Location
    1. Welcom2 to the forum - take a minute and read the FAQs in the link in my sig

    2. I added [CODE] tags around your macro to set it off and do some formatting. You can use the [#] icon to do that

    3. Can you attach a small WB that shows the issue? It makes it easier
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,010
    Location
    Make sure there is a ColHeads(i, 1) in Shelter Headers
    You might try dropping the ", 1" from the U/L boundary codes
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  4. #4
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,656
    Without a sample Workbook ?

  5. #5
    VBAX Regular
    Joined
    Nov 2019
    Posts
    7
    Location
    Quote Originally Posted by SamT View Post
    Make sure there is a ColHeads(i, 1) in Shelter Headers
    You might try dropping the ", 1" from the U/L boundary codes
    1. There are headers (in row 1) in the worksheet Shelter. There are none in Headers.xlsx (Column_Headers).
    2. I tried removing ",1" from the U/L boundary codes, but that didn't make any difference.
    3. I'm going to have to build a small "DB" with non-confidential information. That may take a couple of days.

    Thanks to all for their input.

    Jeff

  6. #6
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,010
    Location
    There are headers (in row 1) in the worksheet Shelter. There are none in Headers.xlsx (Column_Headers).
    Then ColHeads is empty

    ColHeads = Worksheets("Column_Headers").Cells(1).CurrentRegion.Value
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  7. #7
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,809
    Location
    Quote Originally Posted by JeffH View Post
    1. There are headers (in row 1) in the worksheet Shelter. There are none in Headers.xlsx (Column_Headers).
    2. I tried removing ",1" from the U/L boundary codes, but that didn't make any difference.
    3. I'm going to have to build a small "DB" with non-confidential information. That may take a couple of days.

    Thanks to all for their input.

    Jeff

    I think just a WB with the 2 sheets and 1-2 rows of junk data would bo all that is needed
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  8. #8
    VBAX Expert
    Joined
    Apr 2005
    Posts
    767
    Location
    Re: "but now it doesn't"
    What did you change between when it worked and when it quit working?
    It might be something you don't think would affect it but maybe it does.
    Does Worksheet Shelter have the same amount of headers as there are in Column A in Worksheet ColumnHeader?

  9. #9
    VBAX Expert
    Joined
    Apr 2005
    Posts
    767
    Location
    What happens if you replace this
    With Worksheets("Shelter")
            For i = LBound(ColHeads, 1) To UBound(ColHeads, 1)
                .Rows(1).Find(ColHeads(i, 1)).Value = ColHeads(i, 2)
            Next i
        End With
    with this?
    With Worksheets("Shelter")
            For i = LBound(ColHeads, 1) To UBound(ColHeads, 1)
                If Not IsError(Application.Match(ColHeads(i, 1), .Rows(1), 0)) Then
                    .Rows(1).Find(ColHeads(i, 1)).Value = ColHeads(i, 2)
                End If
            Next i
        End With

  10. #10
    VBAX Regular
    Joined
    Nov 2019
    Posts
    7
    Location
    Hi,
    the change suggested by jolivanes did not work. I went back to a previous copy of the code and it didn't work either. Can't really find what I recently changed that would cause this error.

    I'm replying to Paul Hossler's message with a copy of the code.

    Thanks

  11. #11
    VBAX Regular
    Joined
    Nov 2019
    Posts
    7
    Location
    Attached is the Excel Code in Master SCD Code.xlsm. Two lines were changed which included different file paths. I just change to the root of the C:\ drive.

    ActiveWorkbook.SaveAs fileName:="C:\Excelready.xls", FileFormat:= _

    "C:\Headers.xlsx"

    There are two additional files also attached Headers.xlsx and Shelters 7.xls. For some reason the forum's system won't let me load Shelters 7.txt which is referred to in the code. I uploaded Shelter 7.xls and if you export it to a tab delimited txt file you can use that.
    Sorry about that inconvenience.


    The error that is created with these samples isn't exactly like the one I originally received but both of them stop short of the End With statement in Sub ChangeColumnHeaders().

    Again, whatever you can glean from this is appreciated.
    Attached Files Attached Files

  12. #12
    VBAX Regular
    Joined
    Nov 2019
    Posts
    7
    Location
    I just realized that I made a mistake in the SCD Master Code that I just sent. Under Sub ChangeColumnHeaders(), the DIM ColHeads is not supposed have anything after. In the code I had put "(42,2) as Integer". That needs to be removed.

  13. #13
    VBAX Expert paulked's Avatar
    Joined
    Apr 2006
    Posts
    538
    Location
    Try adding the -1 and see where that gets you.

        With Worksheets("Shelter")
            For i = LBound(ColHeads, 1) To UBound(ColHeads, 1) - 1
                .Rows(1).Find(ColHeads(i, 1)).Value = ColHeads(i, 2)
    
    
            Next i
        End With
    Semper in excretia sumus; solum profundum variat.

  14. #14
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,656
    Sub M_Headache()
       With GetObject(ThisWorkbook.Path & "\headers.xlsx")
          sn = Sheets(1).UsedRange
          .Close 0
        End With
            
         With Sheets("shelter").UsedRange
          .Cells(1, Columns.Count + 1).Resize(, 7) = Split("SSecondaryPhoneType CPrimaryPhoneType CAlternatePhoneType CAlternatePhoneExt 24HrPOCPhoneType AlternateContact1PhoneType AlternateContact1PhoneType AlternateContact2PhoneType")
           sp = .Value
         End With
         
        With CreateObject("scripting.dictionary")
           For j = 1 To UBound(sn)
              .Item(sn(j, 1)) = sn(j, 2)
           Next
        
            For jj = 1 To UBound(sp, 2) - 7
                sp(1, jj) = .Item(sp(1, jj))
            Next
        End With
        
        c00 = Join(Evaluate("transpose(row(1:" & UBound(sp, 2) & "))"), ",")
        
        For j = 1 To 7
           c00 = Replace(c00, "," & Choose(j, 5, 26, 28, 29, 36, 43, 50) & ",", "," & Choose(j, 5, 26, 28, 29, 36, 43, 50) & "," & UBound(sp, 2) - 7 + j & ",")
        Next
        sn = Application.Index(sn, 0, st)
        
        Sheets("Shelter").Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
    End Sub
    Structuring precedes coding.

  15. #15
    VBAX Regular
    Joined
    Nov 2019
    Posts
    7
    Location
    Quote Originally Posted by snb View Post
    Sub M_Headache()
       With GetObject(ThisWorkbook.Path & "\headers.xlsx")
          sn = Sheets(1).UsedRange
          .Close 0
        End With
            
         With Sheets("shelter").UsedRange
          .Cells(1, Columns.Count + 1).Resize(, 7) = Split("SSecondaryPhoneType CPrimaryPhoneType CAlternatePhoneType CAlternatePhoneExt 24HrPOCPhoneType AlternateContact1PhoneType AlternateContact1PhoneType AlternateContact2PhoneType")
           sp = .Value
         End With
         
        With CreateObject("scripting.dictionary")
           For j = 1 To UBound(sn)
              .Item(sn(j, 1)) = sn(j, 2)
           Next
        
            For jj = 1 To UBound(sp, 2) - 7
                sp(1, jj) = .Item(sp(1, jj))
            Next
        End With
        
        c00 = Join(Evaluate("transpose(row(1:" & UBound(sp, 2) & "))"), ",")
        
        For j = 1 To 7
           c00 = Replace(c00, "," & Choose(j, 5, 26, 28, 29, 36, 43, 50) & ",", "," & Choose(j, 5, 26, 28, 29, 36, 43, 50) & "," & UBound(sp, 2) - 7 + j & ",")
        Next
        sn = Application.Index(sn, 0, st)
        
        Sheets("Shelter").Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
    End Sub
    Structuring precedes coding.
    With the code above, I got this error: "File Name or Class Name Not Found"

    I REPLACED THIS CODE:
    With GetObject(ThisWorkbook.Path & "\headers.xlsx")
    WITH THIS CODE:
    With GetObject("U:\Shelter Contact Update Form\NSS Import Programming\Headers.xlsx")
    AND THIS CODE :
    With GetObject(ThisWorkbook.Path & "U:\Shelter Contact Update Form\NSS Import Programming\Headers.xlsx")
    and STILL GOT THE SAME ERROR.

    It still winds up in the same place and doesn't replace the column headers.
    Any suggestions?

    And thanks for responding.
    Last edited by JeffH; 11-21-2019 at 09:11 AM. Reason: Solved

  16. #16
    VBAX Regular
    Joined
    Nov 2019
    Posts
    7
    Location
    Ok, I saw the post from PaulKed and it was suggested that I put a -1 after: For i = LBound(ColHeads, 1) To UBound(ColHeads, 1) - 1



    That worked. Thank you.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •