Desperate need of a macro or a code ... please HELP??

[dh1231]

Hi All,

I've been struggling for a week and is desperate to find a solution to an excel problem. I've been searching for solutions as well but unfortunately no luck to exactly what I need done in excel. I'm hoping that someone could help?


I have multiple csv files that's produced on a monthly basis. The count of files are not always the same and in each file there are columns that are file specific but some are the same as others. I need to consolidate all the files by copying them into a summary worksheet then I need to copy the consolidated raw data file into a formatted worksheet with the proper column sort.

Is this even doable? Here are the details of what I'm trying to do. I truly appreciate your help in advance.


Note: This is my first time to post in a forum so please forgive me in advance if I'm non-compliant with the forum rules.

Details:
1) 10+ csv files and collectively 80+ columns (all files are in 1 folder on my desktop or LAN folder). The number of files increases from month to month but total number of columns might increase or decrease.
2) In the csv files, some columns are common and others not.
3) Go to the summary workbook, remove previous month's raw and formatted data.
4) Consolidate current month's files (also add columns that are not common to all files) and add each filename in column A into the summary workbook.
5) Copy and paste data into a formatted template based on the column order in the formatted template.

<o></o>

Examples:<o></o>
File #1<o></o>				File #2<o></o>				File # 3<o></o>
Column A<o></o>	Column B<o></o>	Column C<o></o>		Column AA<o></o>	Column C<o></o>	Column D<o></o>		Column A<o></o>	Column B<o></o>	Column Z<o></o>	Column X<o></o>
Result #1:<o></o>	Consolidated File<o></o>
Filename in Column A<o></o>	Column A<o></o>	Column B<o></o>	Column C<o></o>	Column AA<o></o>	Column D<o></o>	Column Z<o></o>	Column X<o></o>
Result #2:<o></o>	Formatted Template<o></o>
Filename in Column A<o></o>	Column A<o></o>	Column B<o></o>	Column C<o></o>	Column D<o></o>	Column X<o></o>	Column Z<o></o>	Column AA<o></o>

<tbody>
</tbody>

 

[SpillerBD]

This is the basic code I use to import CSV files into a worksheet. I have modified it so I can share it (hopefully without messing up the usable code.)
For your purpose it will need modification.

This was written to import x number of files in a CSV format. Original data consist of about 24 actual fields. Depending on the data type expected, it reads as text then evaluates to the appropriate data type before writing to sheet.
I also have several columns that I define as Named Ranges at the end so those fields are easier to call on in formulas defined in another macro I use.
The first part, the file selection, I prefer over the folder method I often see. It allows me to maintain a depository for all the files and select only the ones I need at any given time.
And there is better way to handle the file (as a text stream) that I haven't dug into that could speed up the processing time. Your 80+ columns is going to really add to the processing time. There are several other points in this code that could use improvement, but I haven't felt the need in my application.

Sub Elavon_Txt_Convert()

Dim strtext As String, StrBuFFer As String, fileToOpen As String, fileToSave As String, Field1 As String, Field2 As String, Field3 As String
Dim Field11 As String, Field14 As String
Dim TempCol1 As String, TempCol2 As String, TempCol3 As String, TempCol4 As String, TempCol5 As String, TempCol6 _
  As String, TempCol7 As String, TempCol8 As String, TempCol9 As String, TempCol10 As String, TempCol11 As String, TempCol12 _
  As String, TempCol13 As String, TempCol14 As String, TempCol15 As String, TempCol16 As String, TempCol17 As String, TempCol18 _
  As String, TempCol19 As String, TempCol20 As String, TempCol21 As String, TempCol22 As String
Dim HCCCounter As Double
Dim Field6, Field19 As Double
Dim Field20 As Date, Field18 As Date
Dim fd As FileDialog
Dim vrtSelectedItem As Variant

Application.Calculation = xlManual

HCCCounter = 1
fileToOpen = ""
MySheetName1 = "CSVs Imported"
Worksheets.Add.Name = MySheetName1
'Set headers on sheet
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 1).Value = "Field1"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 2).Value = "Field2"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 3).Value = "Field3"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 5).Value = "Field4"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 4).Value = "Field5"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 6).Value = "Field6"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 7).Value = "Field7"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 8).Value = "Field8"
'Set additional headers on sheet
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 9).Value = "Field9"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 10).Value = "Field10"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 11).Value = "Field11"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 12).Value = "Field12"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 13).Value = "Field13"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 14).Value = "Field14"
Worksheets(ActiveSheet.Name).Cells(HCCCounter, 15).Value = "Field15"
HCounter = HCounter + 1

MsgBox "Please select the appropriate TXT files for evaluation:" & vbCrLf & _
"Use SHIFT or CTRL to select multiple Files at once." & vbCrLf & vbCrLf & _
"", vbInformation, ""

Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Filters.Clear
    .Filters.Add ".txt Files", "*.txt"
    .AllowMultiSelect = True
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
' MsgBox "Processing file: " & vrtSelectedItem
Next
Else
Stop
End If

Application.ScreenUpdating = False
For Each vrtSelectedItem In .SelectedItems
    fileToOpen = vrtSelectedItem
    Open fileToOpen For Input As #1
    Do While Not EOF(1)
    Line Input #1, StrBuFFer 'Get text line and parse by tabs for first 21 columns, delimiter is comma
    StrBuFFer = Trim(StrBuFFer)
    StrBuFFer = Application.WorksheetFunction.Substitute(StrBuFFer, ",", vbTab)
    
If Len(StrBuFFer) > 130 Then 'verifies string is a Data line
    'All data is initially handled as text strings.
    tab1 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, 1) 'Locates first Tab character in String
    TempCol1 = Mid(StrBuFFer, 1, tab1) 'Captures value
    tab2 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab1 + 1) 'Locates next Tab in string
    TempCol2 = Mid(StrBuFFer, tab1, tab2 - tab1)
    tab3 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab2 + 1)
    TempCol3 = Mid(StrBuFFer, tab2, tab3 - tab2)
    tab4 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab3 + 1)
    TempCol4 = Mid(StrBuFFer, tab3, tab4 - tab3)
    tab5 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab4 + 1)
    TempCol5 = Mid(StrBuFFer, tab4, tab5 - tab4)
    tab6 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab5 + 1)
    TempCol6 = Mid(StrBuFFer, tab5, tab6 - tab5)
    tab7 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab6 + 1)
    TempCol7 = Mid(StrBuFFer, tab6, tab7 - tab6)
    tab8 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab7 + 1)
    TempCol8 = Mid(StrBuFFer, tab7, tab8 - tab7)
    tab9 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab8 + 1)
    TempCol9 = Mid(StrBuFFer, tab8, tab9 - tab8)
    tab10 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab9 + 1)
    TempCol10 = Mid(StrBuFFer, tab9, tab10 - tab9)
    tab11 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab10 + 1)
    TempCol11 = Mid(StrBuFFer, tab10, tab11 - tab10)
    tab12 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab11 + 1)
    TempCol12 = Mid(StrBuFFer, tab11, tab12 - tab11)
    tab13 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab12 + 1)
    TempCol13 = Mid(StrBuFFer, tab12, tab13 - tab12)
    tab14 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab13 + 1)
    TempCol14 = "'" & Mid(StrBuFFer, tab13, tab14 - tab13)
    tab15 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab14 + 1)
    TempCol15 = Mid(StrBuFFer, tab14, tab15 - tab14)
    tab16 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab15 + 1)
    TempCol16 = Mid(StrBuFFer, tab15, tab16 - tab15)
    tab17 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab16 + 1)
    TempCol17 = Mid(StrBuFFer, tab16, tab17 - tab16)
    tab18 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab17 + 1)
    TempCol18 = Mid(StrBuFFer, tab17, tab18 - tab17)
    tab19 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab18 + 1)
    TempCol19 = Mid(StrBuFFer, tab18, tab19 - tab18)
    tab20 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab19 + 1)
    TempCol20 = Mid(StrBuFFer, tab19, tab20 - tab19)
    tab21 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab20 + 1)
    TempCol21 = Mid(StrBuFFer, tab20, tab21 - tab20)
    tab22 = Application.WorksheetFunction.Find(vbTab, StrBuFFer, tab21 + 1)
    TempCol22 = Mid(StrBuFFer, tab21, tab22 - tab21)

' TRIM & CLEAN to make sure non-printing characters including spaces, tab and carriage returns are not included in text values.
If Len(TempCol1) > 6 Then 'TempCol# only have valid data for this condition
   Field1 = Trim(Application.WorksheetFunction.Clean(TempCol1)) 'None String variables could otherwise yield TYPE MISMATCH error
    Field2 = Trim(Application.WorksheetFunction.Clean(TempCol2))
    Field3 = Trim(Application.WorksheetFunction.Clean(TempCol4))
    Field6 = Val(TempCol6)
    Field18 = CDate(TempCol18)
    Field11 = Trim(Application.WorksheetFunction.Clean(TempCol11))
    Field14 = Application.WorksheetFunction.Clean(TempCol14)
    Field19 = Val(TempCol19)
    Field20 = CDate(TempCol20)
        'Field14A
    If Field11 = "AE" Then
        Field14A = "AE"
    Else
        Field14A = "VMD"
    End If
'Actual placement of data in cells
    Worksheets(ActiveSheet.Name).Cells(HCounter, 1).Value = "'" & Field1
    Worksheets(ActiveSheet.Name).Cells(HCounter, 2).Value = "'" & Field2
    Worksheets(ActiveSheet.Name).Cells(HCounter, 15).Value = "'" & Field3
    Worksheets(ActiveSheet.Name).Cells(HCounter, 3).Value = Field6
    Worksheets(ActiveSheet.Name).Cells(HCounter, 5).Value = Field11
    Worksheets(ActiveSheet.Name).Cells(HCounter, 4).Value = Field14
    Worksheets(ActiveSheet.Name).Cells(HCounter, 6).Value = Field18
    Worksheets(ActiveSheet.Name).Cells(HCounter, 7).Value = Field19
    Worksheets(ActiveSheet.Name).Cells(HCounter, 8).Value = Field20
    Worksheets(ActiveSheet.Name).Cells(HCounter, 9).Value = "=VLOOKUP(RC[-8],LUTable1,2,FALSE)"
    Worksheets(ActiveSheet.Name).Cells(HCounter, 10).Formula = HCounter - 1
    Worksheets(ActiveSheet.Name).Cells(HCounter, 11).Value = "=INDEX(CCD_ForCC,MATCH(RC[1],CCD_Key,0))"
    Worksheets(ActiveSheet.Name).Cells(HCounter, 12).Value = "=TEXT(RC[-7],""0"")&"":""&TEXT(RC[-9]*100,""0"")"
    Worksheets(ActiveSheet.Name).Cells(HCounter, 13).Value = "=Index(CCD_CSCTR,Match(RC[-1],CCD_Key,0))"
    Worksheets(ActiveSheet.Name).Cells(HCounter, 14).Value = Field14A
    HCCCounter = HCounter + 1 'set counter to next row for output.
End If
End If
Loop
Close
Next
Columns("A:N").EntireColumn.AutoFit
End With

'Create Named ranges
Dim ElavonData As Range
Dim ElavonField14 As Range
ActiveWorkbook.Names.Add Name:="DataRange1", RefersToR1C1:= _
"=Elavon!R1C1:R" & HCounter & "C15"
ActiveWorkbook.Names.Add Name:="DataRange2", RefersToR1C1:= _
"=Elavon!R1C5:R" & HCounter & "C5"
ActiveWorkbook.Names.Add Name:="DataRange3", RefersToR1C1:= _
"=Elavon!R1C12:R" & HCounter & "C12"
ActiveWorkbook.Names.Add Name:="DataRang4", RefersToR1C1:= _
"=Elavon!R1C9:R" & HCounter & "C9"

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Close 'close all open file handles
End Sub