Removing mulitple columns based on header title

[glatchman]

Hello,

I have excel-files that are in a chronological order inside of a folder. I want to extract every Sheet1 from the individual excel-files and combine into one single excel-file with a single sheet. So far, I have successfully achieved that with the code. However, there is a lot of unnecessary data that follows in the copy & paste process, and I?m only interested in one column. Im trying to remove these "unnecessary" columns at the final step in my code on the sheet with all the data is pasted for the summarized excel-file. However, I have tried multiple approaches and it won?t work. The error I have is " Run-time error '1004'.. Please help!

Here is the code:

Sub Open_All_Excel_Files_in_a_Folder_and_Copy_Data()


' Select file location and open excel worksbooks to copy "Sheet1" into a seperate workbook to collect all data from the other files'

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Sheet_Name = "Sheet1"
Set New_Workbook = ThisWorkbook

Set File_Dialog = Application.FileDialog(msoFileDialogFolderPicker)
File_Dialog.AllowMultiSelect = False
File_Dialog.Title = "Select the Excel Files"
If File_Dialog.Show <> -1 Then
Exit Sub
End If

File_Path = File_Dialog.SelectedItems(1) & ""
File_Name = Dir(File_Path & "*.xls*")

ActiveColumn = 0
Do While File_Name <> ""
Set File = Workbooks.Open(Filename:=File_Path & File_Name)
File.Worksheets(Sheet_Name).UsedRange.Copy
ActiveColumn = ActiveColumn + 1
New_Workbook.Worksheets(Sheet_Name).Cells(1, ActiveColumn).PasteSpecial Paste:=xlPasteAll
ActiveColumn = ActiveColumn + File.Worksheets(1).UsedRange.Columns.Count
File_Name = Dir()

Loop


'Removing columns on row 2 based on the header'

last_column = Worksheets("Sheet1").Cells(2, Columns.Count).End(x1ToLeft).Column
For i = 1 To last_column
If Cells(2, i).Value = "MX840B_CH_2" Then
Columns(i).Delete
End If

If Cells(2, i).Value = "MX840B_CH_3" Then
Columns(i).Delete
End If


Next

End Sub

[Artik]

A fairly common mistake. Instead of x1ToLeft it should be xlToLeft. But there are many more errors in the code.

Try the revised macro:

Please Login or Register  to view this content.

Artik

[glatchman]

Thank you so much for the help, it really helped me to move forward with the code Sorry for the late reply, did not expect such a quick response!

However, there is one thing that i struggle with is that when i select the folder it wont organize my data in a "ascending order" as it does inside of the folder. The files are numerically categorized for an example "1mm_F_1" or "1mm_B_1" this will go up to number 12 . It seems that the code won?t paste the values in a chronological order specifically for "1" and "11". In other words, will start to paste values from workbook "1_B_1" after that it will jump from "1" to "11_B_1" and skip "2_B_1" , 3_F_1, "4_F_1" etc and once "11" is pasted it will start to paste " 2_B_1", "3_B_1" etc. It seems that the code cant tell difference between 1 and 11, which is really confusing to me. Inside of the folder it follows the ascending order, but the code does not..

*I have done some additional modifications on the by removing the pop-up windows, removing blank columns and added ranges in that "ascending order" that the folder has where the pasted values should be at.*

Sub Open_All_Excel_Files_in_a_Folder_and_Copy_Data_1()
Dim ShTarget As Worksheet
Dim Sheet_Name As String
Dim File_Dialog As FileDialog
Dim File_Path As String
Dim File_Name As String
Dim lColL As Long
Dim lColS As Long
Dim wbFile As Workbook
Dim i As Long


' Select file location and open excel worksbooks to copy "Sheet1" into a seperate workbook to collect all data from the other files'

Sheet_Name = "Sheet1"
Set ShTarget = ThisWorkbook.Worksheets(Sheet_Name) 'Function to find sheet1'

Set File_Dialog = Application.FileDialog(msoFileDialogFolderPicker) ' Allows us to select one or multiple files'

File_Dialog.AllowMultiSelect = False 'Create the ability to select one or more files depedent on true/false'
File_Dialog.Title = "Select the Excel Files"

If File_Dialog.Show <> -1 Then
Exit Sub
End If

Application.DisplayAlerts = False 'Closes pop-up windows'



File_Path = File_Dialog.SelectedItems(1) ' The code for when the file patch is choosen it will open all files automatically'
If Right(File_Path, 1) <> Application.PathSeparator Then
File_Path = File_Path & Application.PathSeparator
End If

File_Name = Dir(File_Path & "*.xls*")

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual





lColL = 0

Do While File_Name <> ""
Set wbFile = Workbooks.Open(Filename:=File_Path & File_Name)
wbFile.Worksheets(Sheet_Name).UsedRange.Copy
lColL = lColL + 1
lColS = lColL

ShTarget.Cells(1, lColL).PasteSpecial Paste:=xlPasteAll
lColL = lColL + wbFile.Worksheets(Sheet_Name).UsedRange.Columns.Count
File_Name = Dir()
wbFile.Close False

'Removing columns on row 2 based on the header'
For i = lColL To lColS Step -1
If ShTarget.Cells(2, i).Value = "Time 1 - default sample rate" Or ShTarget.Cells(2, i).Value = "MX840B_CH_1" Or ShTarget.Cells(2, i).Value = "MX840B_CH_2" Or ShTarget.Cells(2, i).Value = "MX840B_CH_4" Or ShTarget.Cells(2, i).Value = "MX840B_CH_5" Or ShTarget.Cells(2, i).Value = "MX840B_CH_6" Or ShTarget.Cells(2, i).Value = "MX840B_CH_7" Or ShTarget.Cells(2, i).Value = "MX840B_CH_8" Or ShTarget.Cells(2, i).Value = "" Then
ShTarget.Columns(i).Delete
lColL = lColL - 1
End If
Next i

Loop

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic



'Print text as headers'

Range("A49").Value = "1_F"
Range("B49").Value = "1_F"
Range("C49").Value = "1_F"
Range("D49").Value = "1_B"
Range("E49").Value = "1_B"
Range("F49").Value = "1_B"
Range("G49").Value = "2_F"
Range("H49").Value = "2_F"
Range("I49").Value = "2_F"
Range("J49").Value = "2_B"
Range("K49").Value = "2_B"
Range("L49").Value = "2_B"
Range("M49").Value = "3_F"
Range("N49").Value = "3_F"
Range("O49").Value = "3_F"
Range("P49").Value = "3_B"
Range("Q49").Value = "3_B"
Range("R49").Value = "3_B"
Range("S49").Value = "4_F"
Range("T49").Value = "4_F"
Range("U49").Value = "4_F"
Range("V49").Value = "4_B"
Range("W49").Value = "4_B"
Range("X49").Value = "4_B"
Range("Y49").Value = "5_F"
Range("Z49").Value = "5_F"
Range("AA49").Value = "5_F"
Range("AB49").Value = "5_B"
Range("AC49").Value = "5_B"
Range("AD49").Value = "5_B"
Range("AE49").Value = "6_F"
Range("AF49").Value = "6_F"
Range("AG49").Value = "6_F"
Range("AH49").Value = "6_B"
Range("AI49").Value = "6_B"
Range("AJ49").Value = "6_B"
Range("AK49").Value = "7_F"
Range("AL49").Value = "7_F"
Range("AM49").Value = "7_F"
Range("AN49").Value = "7_B"
Range("AO49").Value = "7_B"
Range("AP49").Value = "7_B"
Range("AQ49").Value = "8_F"
Range("AR49").Value = "8_F"
Range("AS49").Value = "8_F"
Range("AT49").Value = "8_B"
Range("AU49").Value = "8_B"
Range("AV49").Value = "8_B"
Range("AW49").Value = "9_F"
Range("AX49").Value = "9_F"
Range("AY49").Value = "9_F"
Range("AZ49").Value = "9_B"
Range("BA49").Value = "9_B"
Range("BB49").Value = "9_B"
Range("BC49").Value = "10_F"
Range("BD49").Value = "10_F"
Range("BE49").Value = "10_F"
Range("BF49").Value = "10_B"
Range("BG49").Value = "10_B"
Range("BH49").Value = "10_B"
Range("BI49").Value = "11_F"
Range("BJ49").Value = "11_F"
Range("BK49").Value = "11_F"
Range("BL49").Value = "11_B"
Range("BM49").Value = "11_B"
Range("BN49").Value = "11_B"
Range("BO49").Value = "12_F"
Range("BP49").Value = "12_F"
Range("BQ49").Value = "12_F"
Range("AZ49").Value = "12_B"
Range("BA49").Value = "12_B"
Range("BB49").Value = "12_B"

End sub

[nimrod1313]

It seems that the code cant tell difference between 1 and 11, which is really confusing to me.

This is standard way a number as part of a string would be sorted, when a number is part of a string it is no longer a number it's sorted just like any other character.
Just like you'd expect AAA come before B you should expect 111 come before 2 , when part of a string.

[romperstomper]

@glatchman

You really need to use code tags when posting code.

[nimrod1313]

Your fill of Range("A") to Range("BB49") can be accomplished with this ...

Please Login or Register  to view this content.

[nimrod1313]

Please Login or Register  to view this content.

[glatchman]

Thanks for the suggestions for polishing my code! That makes completely sense because the DIR function goes in the folder and looks for the string data to sort by. In this case my files are named in a arbitrary way, I can name the files in alphabetic order, but its not that intuitive to do that. I guess i have to change my File_Path and use SetAttr instead of defining it as a String? I

[glatchman]

I should maybe use FileSystemObject method instead of DIR i realized.