VBA keeps deleting column headers

[gelen4o]

Hi,

I have a VBA code that imports values from other .csv files. I make use of "Offset" to skip the first row in each target file (column headers) and have the titles hard coded in my destination sheet. Problem is: when the entire code runs it automatially deletes all column headers. I narrowed it down to the delimit values piece but have no idea how to define my ranges properly and this is really bugging me.

What I want is for excel to import .csv values from other sheets, skip their first rows but leave my row1 in the destination file untouched and delimit values.

Here is the code I use

Private Sub CommandButton2_Click()
'Import Position Data and Refresh Pivot Tables

Dim pos As Worksheet
Dim import1 As Variant     ' import pop-up window

Dim import2 As Variant     ' loop through each file to be imported

Dim pt As PivotTable       ' each pivottable

Dim ws As Worksheet        ' each worksheet in workbook

Dim y As Integer           ' delete additional headers range index

Set pos = ActiveWorkbook.Worksheets("Position Data")

'Disable Excel Messages & Automated Calculations:

Application.DisplayAlerts = False

Application.CutCopyMode = False

Application.Calculation = xlCalculationManual

'remove filters if any
On Error Resume Next

   If pos.AutoFilterMode Then pos.ShowAllData

Resume

'Delete old data in range A to CL:

                 With pos
                    
                      .Range("A2:CL" & Rows.Count).Clear
                      
                 End With
                 
'Import Position files (.ok extensions - change to .xls or other if needed):

                 import1 = Application.GetOpenFilename(Filefilter:="OK Files (*.ok*),*.ok*", _

                           Title:="Select .OK files List to Import", MultiSelect:=True)
    
                 If VarType(import1) = vbBoolean Then Exit Sub
    
    
   For Each import2 In import1
   
        With Workbooks.Open(import2)
            
             .Worksheets(1).UsedRange.Offset(1).Copy
             
                  pos.Cells(pos.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial _

                  Paste:=xlPasteValues, operation:=xlPasteSpecialOperationNone
                  
              .Close savechanges:=False
                  
         End With
   
   Next import2
   
   
'Delimit imported data
   
     With pos
    
        .Columns("A").TextToColumns Destination:=.Range("A1"), _

                                DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _

                                ConsecutiveDelimiter:=False, Tab:=True, _

                                Semicolon:=False, Comma:=True, Space:=False, Other:=False, _

                                TrailingMinusNumbers:=True

     End With
                     
        
'Turn alerts & automated calculations back on

Application.DisplayAlerts = True

Application.Calculation = xlCalculationAutomatic

pos.Range("A:CZ").HorizontalAlignment = xlcentrer

'Refresh PivotTables in entire Workbook

                    For Each ws In ActiveWorkbook.Worksheets
                    
                               For Each pt In ws.PivotTables
                               
                                             pt.RefreshTable
                                             
                               Next pt
                    
                    Next ws
                                                  
End Sub

 

[JackDanIce]

Try:

Private Sub CommandButton2_Click()

    Dim wks     As Worksheet
    
    Dim varInp  As Variant
    Dim var     As Variant
    Dim arr()   As Variant
    
    Dim x       As Long
    Dim y       As Long
    Dim w       As Long
    
    Dim pt      As PivotTable
    
    varInp = Application.GetOpenFilename(Filefilter:="OK Files (*.ok*),*.ok*", Title:="Select .OK files List to Import", MultiSelect:=True)
    If Not varInp Then Exit Sub
    
    Set wks = Sheets("Position Data")
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    With wks
        On Error Resume Next
        If .AutoFilterMode Then .ShowAllData
        On Error GoTo 0
        
        x = .Cells(.Rows.count, 315).End(xlUp).row
        .Cells(2, 1).Resize(x - 1, 315).ClearContents
        
        For Each var In varInp
            With Workbooks.Open(var, ReadOnly:=True)
                With .Sheets(1)
                    x = .Cells(.Rows.count, 1).End(xlUp).row
                    y = .Cells(1, .Columns.count).End(xlToLeft).column
                    arr = .Cells(2, 1).Resize(x - 1, y).Value
                    wks.Cells(Rows.count, 1).End(xlUp).Offset(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
                    Erase arr
                End With
                .Close False
            End With
        Next var
        
        x = .Cells(.Rows.count, 1).End(xlUp).row
        y = .Cells(1, .Columns.count).End(xlToLeft).column
        
        With .Cells(1, 1).Resize(x, y)
            .TextToColumns Destination:=.Cells(1, 1), _
                DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=True, Comma:=True, TrailingMinusNumbers:=True
            .HorizontalAlignment = xlCenter
        End With
    End With
    
    Application.Calculation = xlCalculationAutomatic
        
    For w = 1 To Worksheets.count
        With Sheets(w)
            For Each pt In .PivotTables
                pt.RefreshTable
            Next pt
        End With
    Next w
    
    Application.ScreenUpdating = True
    
    Set wks = Nothing
    
End Sub

 

[gelen4o]

Thank you very much good Sir !

What if I wanted to import .ok files from a specific folder but with variable names ?(will always have "APK" or "POS" + data (yyyy-mm-dd) in name string)

I need to import data for 12 months and was thinking of looping through dates ( date + 1) so excel can pick up the next file in line.

 

[JackDanIce]

See if this link helps: https://www.thespreadsheetguru.com/...oop-through-all-excel-files-in-a-given-folder

 

[gelen4o]

See if this link helps: https://www.thespreadsheetguru.com/...oop-through-all-excel-files-in-a-given-folder

Thank you for the suggestion ! I helped a bit but I still remain confused as to define my target file names properly so any futher suggestions would really help me out.

The files I work with have names such as "APOS101617.csv.20171017060948" and there are 4 files for each date (TPOS, APOS, LPOS & DPOS). First 4 characters will always remain the same but the date will vary from day to day.

I want VBA to loop through the folder and import all 4 files for 01/01/2017, do a specific calculation for this exact date and then save the value before moving onto 02/01/2017 and next 4 files subsequently ... so on and so on. The folder contains data for 12 months so there are at least 320 (1 set = 4 files) sets of files to be ran through

All dates from 01/01/2017 to 31/12/2017 are listed in sheet "assum" and I want excel to pick every row on the basis of assum.cells(u, "D") and incorporate whatever the date in this row into the target filename for all TPOS, APOS, LPOS & DPOS files.

So far I selected files via a dialog box that promped but now I just want to point VBA to an exact folder and leave it work on its own.

Private Sub CommandButton2_Click()
'Import Position Data and Refresh Pivot Tables

Dim assum As Worksheet

Dim pos As Worksheet

Dim import1 As Variant     ' import pop-up window

Dim import2 As Variant     ' loop through each file to be imported

Dim mypath As String

Dim myfile As String

i = 0
u = 5                      ' next date index

Set pos = ActiveWorkbook.Worksheets("Position Data")

Set assum = ActiveWorkbook.Worksheets("Assumptions")

myextension = ".ok"

mypath = "C:\Users\i936078\.......\Source Data\"

myfile = Dir(mypath & myextension)

'Disable GUI and calculations

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.Calculation = xlCalculationManual
                
'remove filters if any

On Error Resume Next

   If pos.AutoFilterMode Then pos.ShowAllData

Resume

'Delete old data in range A to CL:

Do While assum.Cells(u, "D") <> ""

                 With pos
                    
                      .Range("A2:CL" & Rows.Count).Clear
                      
                 End With
                 
                 'Import Position files (.ok):
                                   import1 = Workbooks.Open(Filename:=mypath & myfile)
    
                                   If VarType(import1) = vbBoolean Then Exit Sub
    
    
                  For Each import2 In import1
   
                      With Workbooks.Open(import2)
            
                          .Worksheets(1).UsedRange.Offset(1).Copy
             
                                     pos.Cells(pos.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial _
                                     Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationNone
                  
                          .Close SaveChanges:=False
                  
                     End With
   
                  Next import2
   
   
                 'Delimit imported data
   
                  With pos
    
                  .Columns("A").TextToColumns Destination:=.Range("A1"), _
                                DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                                ConsecutiveDelimiter:=False, Tab:=True, _
                                Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
                                TrailingMinusNumbers:=True

                 End With
                                        
                 
                             
                 u = u + 1 'take next date in line
                 
Loop
        
'Turn alerts & automated calculations back on
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
pos.Range("A:CZ").HorizontalAlignment = xlcentrer
                    
'Column headers pos file
 

End Sub