Code to loop through Excel files column headings replace spaces and special characters for import into SQL Server

[Joyner]

Hello and thank you for the help, especially since I know I am asking a lot. Hopefully someone already has code for what I need to do. I have tried a search but haven’t found anything that appears to do what I need.

I truly appreciate and help that can get me started in the right direction.

I need code that essentially is preparing excel files column header/field names for import into sql server (someone else is doing that part). The column headers currently have spaces/special characters that need to be replaced with the underscore character “_”.

I do not know how to write this type of code and there are several additional challenges.

1. I need code that will loop through several hundred of the Excel files in a file folder (folder names will vary). Each Excel file has only one sheet - Sheet1

2. For each file, loop through the first row (column headings starting in A1) and for each column heading replace any space or other special character with the underscore character – so each heading should only contain letters, numbers and the underscore

Some challenges:

The number of column headings range from roughly 90 to 140.

Some of the column headings are duplicated, (general there may be two or three duplicates, I know this is crazy but I can’t do anything about that), so for each duplicate, the second occurrence needs to be appended with a 1 (one) at the end of the name, and the third occurrence needs to be appended with a 2 (two), and so on. For example the second occurrence of xyz would be named xyz1 and the third occurrence needs to be named xyz2, etc.

There are some column headings that are blank (again I know this is crazy but I can’t do anything about this either in the hundreds of files). So the code that is looping through needs to loop through all the way to the last column heading with a value in it. For each blank column heading I want to insert a name, like Blank1, blank2, etc.

Again, thank you for any assistance that can get me started.

I’ll try to tackle the next part after I get this part done, I will need to covert the excel files to csv files, but instead to the comma delimiter, they want a pipe/stick character because some data contains commas…

 

[Joyner]

So I found some code from Rick Rothstein to remove non alpha and numeric characters and I was able to figure out how to handle the blank and duplicate columns. I'm not sure if it is the most efficient use (mostly the Application.WorksheetFunction part) but with testing it appears to be working properly. Now I just need to add it to code to loop it through all Excel files in a folder and then save as a csv file. I did find how to change the comma delimiter to a pipe.

Any recommendations are appreciated. Thanks

Sub CleanColumnHeaders()
'To properly structure the Excel column headings for import into a database
'- remove special characters from column headings and resolve blank and duplicate column headings
'Adapted from Sub RemoveNonAlphaNumericCharacters()from Rick Rothstein
 Dim X As Long, Text As String, Cell As Range, Rng As Range, LastColumn As Long
 Dim sCounter As Long, dCount As Long, c As Long
    
    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column ' Find last used column number
    Set Rng = Range(Cells(1, 1), Cells(1, LastColumn))
    sCounter = 1
 
 'For non blank cells, replace any non alpha or numeric characters with an underscore "_"
 For Each Cell In Rng
    If Cell.Value <> "" Then
        Text = Cell.Value
        For X = 1 To Len(Text)
            If Mid(Text, X, 1) Like "[!A-Za-z0-9]" Then Mid(Text, X) = Chr(1)
        Next
        Cell = Replace(Text, Chr(1), "_")
        Text = Cell.Value
    End If
    
'For blank cells, replace with "Column" and a counter, 1, 2, 3 etc.
    If Cell.Value = "" Then
        Cell.Value = "Column" & sCounter
        sCounter = sCounter + 1
    End If
 Next
 
 'For any duplicate column headings add a counter so they are no longer duplicates
 For c = LastColumn To 1 Step -1
 Text = Cells(1, c).Value
 dCount = Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(1, c)), Text)
    If dCount > 1 Then
        Cells(1, c).Value = Text & dCount - 1
    End If
 Next c
 
 End Sub

 

[Joyner]

FYI, I appear to have everything working - for anyone who needs the solution:

I used this code from the spreadsheet guru:

https://www.thespreadsheetguru.com/...oop-through-all-excel-files-in-a-given-folder

I added the below code to run my code above, save the Excel file processed, list each file processed, then save the file as a CSV file:

Dim fCount As Long ' Count of files processed
Dim r As Long
  
  fCount = 1
  r = 2

 Application.DisplayAlerts = False
    
    'Save the changes
    ActiveWorkbook.Save
        ThisWorkbook.ActiveSheet.Range("A" & r) = wb.Name 'insert the workbook name starting in cell A2
        ThisWorkbook.ActiveSheet.Range("B" & r) = fCount 'add a count column stating in cell B2
        r = r + 1
        fCount = fCount + 1
    
    'Save as a csv file for import
    ActiveWorkbook.SaveAs FileFormat:=xlCSV
    
    'Close Workbook
      wb.Close
      
    Application.DisplayAlerts = True