• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 244
  • Last Modified:

Update to Code from a Previous Question

Sir/Madam,

In a previous question, Experts Exchange Expert Imnorie created a VB macro that takes data from a .CSV file and places it into an Excel table.  The code works based upon original requirements and the Expert did a great job.  One of the questions that Imnorie had asked is if the 9 categories (see attached spreadsheet) will be the same for each airline.  I said yes.  Then, after being supplied the entire data set (I was only given two airlines to test), I then realized that some airlines only had 6 categories, causing the 3 categories from the next airline to appear in the airline before it.  I am looking to have the code modified to have only the number of categories for that airline to appear in the table for that airline.

======================================

Here is the original request and the macro code that was provided:

Dear Sir/Madam,

I work in the aviation industry compiling data submitted by the US major airline carriers.  Our system is a legacy system and its functionality is limited when it comes to output.

The system will output the data into a .CSV file.  Each month, I need to copy the data into a table with headings, name of carrier, year, etc.  It is a very time consuming processes as we have 900-1000 carriers.  Could you create a macro that automatically performs these steps?  The data needs to appear in a table format structure for our external and internal customers.

I have attached my spreadsheet.  The data on "Data in CSV format..." is the output data.  The tab of "Data in XLS Format..." is what I am trying to accomplish.  I have placed notes into this tab explaining how the data should be displayed.  Please let me know what you come up with!  I really appreciate the hard work the Experts do to make my job easier!

Thank you.  Please advise with questions.
Option Explicit

Sub CSVToXLS()
    Dim wsData As Worksheet
    Dim wsDst As Worksheet
    Dim rngSrc As Range
    Dim rngDst As Range
    Dim I As Long
    
    Set wsData = Worksheets("Data in CSV Format(Original)")
    Set wsDst = Worksheets.Add
    Set rngSrc = wsData.Range("A1")
    Set rngDst = wsDst.Range("A4")
    While rngSrc.Value <> ""
        With rngDst.Offset(-3)
            .Resize(3).Value = Application.Transpose(Array("INTERNATIONAL CIVIL AVATION ORGANIZATION", _
                                            "AIR TRANSPORT REPORTING FORM D", _
                                            "FLEET AND PERSONNEL - COMMERCIAL AIR CARRIERS"))
            .Resize(, 6).HorizontalAlignment = xlCenterAcrossSelection
        End With
        rngDst.Value = "STATE: " & rngSrc.Offset(, 5)
        rngDst.Offset(1).Value = "AIR CARRIER: " & rngSrc.Offset(, 1) & " (" & rngSrc.Value & ")"
        rngDst.Offset(2).Value = "YEAR ENDED: " & rngSrc.Offset(, 6)
        rngSrc.Offset(, 3).Resize(9, 2).Copy rngDst.Offset(4)  'rngSrc.Offset(3, 3).Resize(2, 2).Copy rngDst.Offset(6)
        'rngSrc.Offset(7, 3).Resize(2, 2).Copy rngDst.Offset(8)
        With rngDst.Offset(4).CurrentRegion
            .Interior.ColorIndex = xlNone
            .BorderAround xlContinuous, xlThin, 0
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = 0
            End With
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = 0
            End With
        
        End With
        
        Set rngSrc = rngSrc.Offset(9)
        Set rngDst = rngDst.Offset(27)
        wsDst.HPageBreaks.Add rngDst.Offset(-3)
    Wend
    wsDst.Range("A:B").EntireColumn.AutoFit

End Sub

Open in new window

========================

In the attached on tab "Current Code is Doing This" (see comments in columns G29-G34), I have explained what the code is currently doing.  In the "Data in XLS Format(Desired)" is how I would like the data to appear.

Please advise with any questions.

Thank you.
James

Prior related question: http:Q_27869211.html
ExpertsExchange-Question9.xlsx
0
James0903
Asked:
James0903
  • 3
  • 2
1 Solution
 
James0903Author Commented:
Aikimark,  Thank you.  I am trying the code out and will advise.
0
 
NorieCommented:
Is the only difference that Delta has 6 rows and the othere 2 airlines have 9 rows?
0
 
NorieCommented:
Try this.
Option Explicit



Sub CSVToXLS()
    Dim wsData As Worksheet
    Dim wsDst As Worksheet
    Dim rngSrc As Range
    Dim rngDst As Range
    Dim rngStart As Range
    Dim rngEnd As Range
    Dim I As Long
    
    Set wsData = Worksheets("Data in CSV Format(Original)")
    Set wsDst = Worksheets.Add
    Set rngSrc = wsData.Range("A1")
    Set rngDst = wsDst.Range("A4")
    While rngSrc.Value <> ""
        With rngDst.Offset(-3)
            .Resize(3).Value = Application.Transpose(Array("INTERNATIONAL CIVIL AVATION ORGANIZATION", _
                                            "AIR TRANSPORT REPORTING FORM D", _
                                            "FLEET AND PERSONNEL - COMMERCIAL AIR CARRIERS"))
            .Resize(, 6).HorizontalAlignment = xlCenterAcrossSelection
        End With
        rngDst.Value = "STATE: " & rngSrc.Offset(, 5)
        rngDst.Offset(1).Value = "AIR CARRIER: " & rngSrc.Offset(, 1) & " (" & rngSrc.Value & ")"
        rngDst.Offset(2).Value = "YEAR ENDED: " & rngSrc.Offset(, 6)
        
        Set rngStart = rngSrc
        Set rngEnd = rngSrc
        
        While rngEnd.Value = rngEnd.Offset(1).Value
        
            Set rngEnd = rngEnd.Offset(1)
        Wend
        
        Range(rngStart, rngEnd).Offset(, 3).Resize(, 2).Copy rngDst.Offset(4)
        
   '     rngSrc.Offset(, 3).Resize(9, 2).Copy rngDst.Offset(4)
        
        'rngSrc.Offset(3, 3).Resize(2, 2).Copy rngDst.Offset(6)
        'rngSrc.Offset(7, 3).Resize(2, 2).Copy rngDst.Offset(8)
        With rngDst.Offset(4).CurrentRegion
            .Interior.ColorIndex = xlNone
            .BorderAround xlContinuous, xlThin, 0
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = 0
            End With
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = 0
            End With
        
        End With
        
        Set rngSrc = rngEnd.Offset(1)
        Set rngDst = rngDst.Offset(27)
        wsDst.HPageBreaks.Add rngDst.Offset(-3)
    Wend
    
    wsDst.Range("A:B").EntireColumn.AutoFit

End Sub

Open in new window

0
 
James0903Author Commented:
Imnorie, thank you.  This code works for me.  Thank you helping me out.  Meant to say to Aikimark in my previous post thank you for fixing my code which became all-in-one upon copying in and applying the link to the previous question.  

Coincidentally, if I have a follow-up question after an Accepted Solution, do I re-open the accepted solution entry or do I start a new question?  You were most familiar with the coding so I was worried that a new question would not get routed to you in attempts to save the re-explanation to another Expert.

Thank you again.
0
 
James0903Author Commented:
Thank you.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now