Dynamic table from csv

[Kostas1977]

I am loading a CSV file into a table with rows from the cell A17 until AG110.. The CSV is not the same every time, so I delete the empty rows of the table.
My problem are the columns.. Since the CSV is different next time I might have more or less columns.
So I need a dynamic table that "reads" the headers of the table from the first line of the CSV file.. and of course "changes" the settings for Autofit and HorizontalAlignment.
Sorry that I have posted all my code but I think it is necessary for understanding of what I am trying to do.
My code is as folllows:

Dim wbCSV As Workbook, n As Long
Dim ws As Worksheet

Set ws = ActiveSheet

Dim currentSheet As Worksheet

    Set currentSheet = ActiveSheet

Dim sheet As Worksheet
    For Each sheet In ActiveWorkbook.Worksheets
        With sheet
            With .Cells.Rows
                .WrapText = True
                .VerticalAlignment = xlCenter
                .EntireRow.AutoFit
            End With '.Cells.Rows
            .Columns.EntireColumn.AutoFit
        End With 'sheet
    Next sheet
    
    currentSheet.Activate

Dim rng As Range
Set rng = Range("A17:T110")

    Set ws = ActiveSheet
    Set wbCSV = Workbooks.Open(folder & fileName, False, True)
    With wbCSV.Sheets(1)
        n = .UsedRange.Rows.Count
        .UsedRange.Copy ws.Range("A17")
    End With
    With rng.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
       
    wbCSV.Close False
    ws.Range("A17:AG17").Interior.Color = RGB(147, 175, 186)
    ws.Range("A17:AG17").Font.Bold = True
    ws.Range("A17:AG17").Font.Size = 12
    ws.Columns("A:AG").HorizontalAlignment = xlCenter
    ws.Columns("A:AG").AutoFit
    ws.Cells.WrapText = True
    ws.Columns("C").NumberFormat = "# €_)"
    ws.Columns("C").HorizontalAlignment = xlLeft
    ws.Rows("7").Resize(n).AutoFit
    ws.Columns.AutoFit
    'check for filter, turn on if none exists
  If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A17").AutoFilter
  End If
  
  Dim EntireRow As Range
    Set rng = Range("A17:AG110")
 
    If Not (rng Is Nothing) Then
        Application.ScreenUpdating = False
 
        For I = rng.Rows.Count To 1 Step -1
            Set EntireRow = rng.Cells(I, 1).EntireRow
            If Application.WorksheetFunction.CountA(EntireRow) = 0 Then
                EntireRow.Delete
            End If
        Next
 
        Application.ScreenUpdating = True
    End If
    
        rng.BorderAround _
 ColorIndex:=1, Weight:=xlThick

 

[rlv01]

Why not just clear the paste range in advance so you don't have to delete rows or columns?

    With wbCSV.Sheets(1)
        n = .UsedRange.Rows.Count
        WS.Range("A17:AG110").ClearContents           '<-- clear the paste range
        .UsedRange.Copy WS.Range("A17")
    End With

To size the header row

    wbCSV.Close False
    Dim CellRange As Range
    With WS.Range("A17")
        Set CellRange = WS.Range(.Offset(0, 0), WS.Cells(.Row, WS.Columns.Count).End(xlToLeft))    'range of data in row
    End With

    With CellRange
        .Interior.Color = RGB(147, 175, 186)
        .Font.Bold = True
        .Font.Size = 12
        .EntireColumn.HorizontalAlignment = xlCenter
        .EntireColumn.AutoFit
    End With

 

[Kostas1977]

I understand your suggestion but it does not solve my problem.
I am posting all my code to be more concise.
I have a CSV file at the same path with my excel and I am loading the data at a "dynamic" table.
The CSV file is not always the same.
I have attached two different CSV files for testing.
The dynamic table should display all the data correctly.
I have managed to display all the rows of the CSV file.
My problem is the columns.
They are not displayed correctly because the table is not fully dynamic.

My code is:

Private Sub Workbook_Open()

Dim wbCSV As Workbook, n As Long
Dim ws As Worksheet
Dim fileName As String
Dim imagePath As String, folder As String

Set ws = ActiveSheet
   
    folder = ThisWorkbook.Path & "\"
    fileName = Dir(ThisWorkbook.Path & "\*.csv")
   
    Range("A1:AE16").Borders.Color = RGB(255, 255, 255)
     With Range("A14").Borders(xlEdgeBottom)
 .LineStyle = xlContinuous
 .Weight = xlThin
 .ColorIndex = 15
 End With
    ActiveCell.Offset(1, 0).Range("A16").Select    

Dim currentSheet As Worksheet

    Set currentSheet = ActiveSheet

    Dim sheet As Worksheet
    For Each sheet In ActiveWorkbook.Worksheets
        With sheet
            With .Cells.Rows
                .WrapText = True
                .VerticalAlignment = xlCenter
                .EntireRow.AutoFit
            End With '.Cells.Rows
            .Columns.EntireColumn.AutoFit
        End With 'sheet
    Next sheet
    
    currentSheet.Activate

Dim rng As Range
Set rng = Range("A17:AG210")

    Set ws = ActiveSheet
    Set wbCSV = Workbooks.Open(folder & fileName, False, True)
    With wbCSV.Sheets(1)
        n = .UsedRange.Rows.Count
        .UsedRange.Copy ws.Range("A17")
    End With
    With rng.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
       
    wbCSV.Close False
    ws.Range("A17:AG17").Interior.Color = RGB(147, 175, 186)
    ws.Range("A17:AG17").Font.Bold = True
    ws.Range("A17:AG17").Font.Size = 12
    ws.Columns("A:AG").HorizontalAlignment = xlCenter
    ws.Columns("A:AG").AutoFit
    ws.Cells.WrapText = True
    ws.Columns("C").NumberFormat = "# €_)"
    ws.Columns("C").HorizontalAlignment = xlLeft
    ws.Rows("7").Resize(n).AutoFit
    ws.Columns.AutoFit
    'check for filter, turn on if none exists
  If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A17").AutoFilter
  End If
    
    Dim EntireRow As Range
    Set rng = Range("A17:AG210")
 
    If Not (rng Is Nothing) Then
        Application.ScreenUpdating = False
 
        For I = rng.Rows.Count To 1 Step -1
            Set EntireRow = rng.Cells(I, 1).EntireRow
            If Application.WorksheetFunction.CountA(EntireRow) = 0 Then
                EntireRow.Delete
            End If
        Next
 
        Application.ScreenUpdating = True
    End If
    
        rng.BorderAround _
 ColorIndex:=1, Weight:=xlThick
    
End Sub

CSV Test 1:

"Project Name","Project Description","Project CAPEX Budget","Work Breakdown Structure","Workflow Current Node","ID","Title","Project Phase","Owner","Business Unit","Risk or Opportunity","Category","Risk Type","Issue","Risk or Opportunity raised on","Active since","Targeted Closure Date","Actual Closure Date","Related Assets","Goals","Schedule Activity ID","Description","Highest Residual Evaluation","Inherent Likelihood","Inherent Impact","Inherent Score","Residual Impact","Residual Likelihood","Current Residual Score","Open Actions","Closed Actions","Risk or Opportunity Status","Action Title"
"000 TEST","MRT Project Risk Register","500000 €","H1B.4072.9999","","RSK-254093","Design changes made during the construction works","3-Contruction","Owner, Owner1","Asset Management","Opportunity","Construction","Internal Risk","","","","03/06/2021","","","","","Design changes are expected during construction due to constructability issues , field conditions , owner driven changes , design errors/omissions, coordination issues.","Environmental","5","5","25","5","5","  25","1","0","Proposed","Allow contigencies"
"000 TEST","MRT Project Risk Register","500000 €","H1B.4072.9999","","RSK-254093","Design changes made during the construction works","3-Contruction","Owner, Owner1","Asset Management","Opportunity","Construction","Internal Risk","","","","03/06/2021","","","","","Design changes are expected during construction due to constructability issues , field conditions , owner driven changes , design errors/omissions, coordination issues.","Environmental","5","5","25","5","5","  25","1","0","Proposed","test 22/7"

CSV Test 2:

"Title","ID","Risk or Opportunity","Issue","Business Unit","Department","Project Phase","Risk or Opportunity Status","Causes","Category","Risk Type","Initiator","Owner","Third Party Name","Risk or Opportunity raised on","Active since","Actual Closure Date","Days Overdue","Overdue","Controls","Child Risk or Opportunity","Schedule Activity ID","Work Breakdown Structure","Projects","Goals","Related Assets","Inherent Score","Open Actions","Closed Actions","Highest Residual Evaluation","Current Residual Score"
"15 Sept Risk to Babis for revert check","RSK-266523","Risk","","Communications","","","Reverted","","","Internal Risk","Liakopoulos, Panos","Kiochou, Anastasia","","15/09/2021","","","","No","","","","","","","","0","0","0","Time Delays",""
"29 sept self test","RSK-266873","Risk","","Sports & Education","","","Active","signing-off punch items","Design","Third Party Risk","Liakopoulos, Panos","Liakopoulos, Panos","Foster & Partners:","29/09/2021","29/09/2021","","","No","","","","H1A.4L41.9999","Vouliagmenis Mall","Increase investors' awareness;Successfully execute LD Malls IPO;Scheduling function integrated with other Project Controls functions;Appoint the PMCs for Infrastructure and Buildings;Complete the recruitment plan of the team;Commercial agreements signed with buyers & JV Investors","","20","0","0","Compliance","  15"

 

[rlv01]

Private Sub Workbook_Open()

    Dim wbCSV As Workbook
    Dim ws As Worksheet
    Dim fileName As String
    Dim folder As String
    Dim sheet As Worksheet

    Set ws = ActiveSheet

    folder = ThisWorkbook.Path & "\"
    fileName = Dir(ThisWorkbook.Path & "\*.csv")

    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(folder & fileName) Then
            MsgBox "Cannot find " & folder & fileName & vbCr & vbCr & "Macro execution halted. ", vbOKOnly Or vbCritical, Application.Name
            Exit Sub
        End If
    End With

    With ws
        .Range("A1:AE16").Borders.Color = RGB(255, 255, 255)
        With .Range("A14").Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 15
        End With
    End With

    For Each sheet In ActiveWorkbook.Worksheets
        With sheet
            With .Cells.Rows
                .WrapText = True
                .VerticalAlignment = xlCenter
                .EntireRow.AutoFit
            End With                                  '.Cells.Rows
            .Columns.EntireColumn.AutoFit
        End With                                      'sheet
    Next sheet

    ws.Activate

    Set wbCSV = Workbooks.Open(folder & fileName, False, True)

    GetCsvData ws, wbCSV
End Sub


Sub GetCsvData(ByRef ws As Worksheet, ByRef wbCSV As Workbook)
    Dim CellRange As Range, RangeToClear As Range

    'clear any data left over from the last time the file was opened.
    Set RangeToClear = Application.Intersect(ws.Range("A17:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row).EntireRow, ws.UsedRange)
    RangeToClear.Clear                                '<-- clear the paste range

    'copy data
    With wbCSV.Worksheets(1)
        .UsedRange.Copy ws.Range("A17")
    End With

    'format "dynamic" header row
    With ws.Range("A17")
        Set CellRange = ws.Range(.Offset(0, 0), ws.Cells(.Row, ws.Columns.Count).End(xlToLeft))    'range of data in header row
    End With

    With CellRange
        .Interior.Color = RGB(147, 175, 186)
        .Font.Bold = True
        .Font.Size = 12
        .EntireColumn.HorizontalAlignment = xlCenter
        .EntireColumn.ColumnWidth = 80
    End With

    'format "dynamic" data
    Set CellRange = Application.Intersect(ws.UsedRange, CellRange.EntireColumn)
    Set CellRange = Application.Intersect(CellRange, ws.Range("A17:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row).EntireRow)
    With CellRange.Offset(1)
        .Cells.WrapText = True
        .Columns("C").NumberFormat = "# €_)"
        .Columns("C").HorizontalAlignment = xlLeft
    End With

    CellRange.Columns.AutoFit

    With CellRange.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With

    CellRange.BorderAround ColorIndex:=1, Weight:=xlThick
End Sub

 

[Kostas1977]

wow.. it works like a charm.. OK I will review your code and I will come back for questions if I have any. Thank you very much indeed

 

[Kostas1977]

One last question.. I have added at the top of my excel a picture, the date/time of the document and the title of the document with the following code:

    Dim wbCSV As Workbook
    Dim  n As Long
    Dim ws As Worksheet
    Dim fileName As String
    Dim folder As String
    Dim imagePath As String
    Dim imgLeft As Double
    Dim imgTop As Double
    Dim sheet As Worksheet
    Dim strname As String
    Dim FileNameArray() As String

    Set ws = ActiveSheet
    
    imagePath = ThisWorkbook.Path & "\" & Dir(ThisWorkbook.Path & "\*.png")
    imgLeft = ActiveCell.Left
    imgTop = ActiveCell.Top

    ws.Shapes.AddPicture _
    fileName:=imagePath, _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, _
    Left:=imgLeft, _
    Top:=imgTop, _
    Width:=-1, _
    Height:=-1

    [A14] = "Date/Time created:"        
    [B14] = Format(Now(), "dd/mm/yy hh:mm")
    [A15] = "Projet Name:"
       
    FileNameArray() = Split(fileName, ".")
    strname = FileNameArray(0)
    Range("B15") = strname      
    Range("B14").Font.Bold = True
    Range("B14").Font.Size = 12
    Range("B15").Font.Bold = True
    Range("B15").Font.Size = 12
    
    ActiveCell.Offset(1, 0).Range("A16").Select

I have noticed that you open the CSV file to get the data with this code:

ws.Activate
    Set wbCSV = Workbooks.Open(folder & fileName, False, True)
    GetCsvData ws, wbCSV

OK. When I open the Excel file, the CSV file is opened simultaneously and gets the title of my document. The Excel document with the dynamic table has title "Sheet 1" and it is not displayed on the top.
Is it possible to "read" the CSV file without open it with Excel?

 

[rlv01]

Is it possible to "read" the CSV file without open it with Excel?

I suppose it is "possible" for you to open the file using VBA directly as a text file and parse it line by line, then write some more code to extract the comma separated data and place it in your worksheet it the proper location, then change all the other bits of code you'll need to change to adapt to that new method and do the formatting you want. But to me that's like asking if it is possible to knit a sweater out of dog hair that you gather yourself. Sure, it would be "possible", but the question is why would you want to? The solution to placing your title where you want it should not need to involve the CSV code.