Sir/Madam,
I am requesting assistance with the coding of a VB macro. Please see attached spreadsheet. In the attached, a macro was created to copy data from the 'CSV' tab into the 'Template' tab (upon running, the final result would appear in the 'Results' tab). The current macro is written for Part I - Fleet (the first table in the 'template' tab, rows 14-49).
Our customers now require additional information for each airline customer. They want to see the employee count. In the 'template' tab I created another table, Part II - Fleet and Personnel (rows 53-63). Unfortunately, my programmer cannot provide the data set needed for Parts I & II in one Excel spreadsheet, thus, tab 'CSV2' has data for Part II.
Can the current macro be updated so that when it runs, it continues to place the data for Part I into the first table, and then places the data for Part II into the second table?
I have attempted to update the program, and had no luck at all (it would embarassing to place it online that is how bad it was!). The "Current Results" is what the code is currently doing. The "Desired Results" is what I am trying to accomplish. When it is completed, each airline should only have 1 page. Though in there are only two airlines of data in the attached, this spreadsheet will be used for 100+ airlines.
Please advise with any questions. Thank you as always for your help!
Sub kTest() Dim wksResult As Worksheet Dim wksTemplate As Worksheet Dim wksCSV1 As Worksheet Dim wksCSV2 As Worksheet Dim rngTemplate As Range Dim rngCSV1 As Range Dim rngCSV2 As Range Dim rngAirC As Range Dim rngDest As Range Dim rngCopy As Range Dim r As Long, c As Long Dim dic As Object, t Dim i As Long, AirC, PartII Application.ScreenUpdating = 0 Set wksTemplate = Worksheets("Template") Set rngTemplate = wksTemplate.Range("A1:T65") Set wksCSV1 = Worksheets("CSV") Set wksCSV2 = Worksheets("CSV2") Set rngAirC = wksCSV1.Range("a1").CurrentRegion.Columns(1) AirC = UNIQUE(rngAirC.Value2) Set dic = CreateObject("scripting.dictionary") dic.comparemode = 1 On Error Resume Next Set wksResult = Worksheets("Result") If Err.Number <> 0 Then Set wksResult = Worksheets.Add wksResult.Name = "Result" End If Err.Clear: On Error GoTo 0 wksResult.UsedRange.Clear Set rngDest = wksResult.Cells(1) PartII = wksTemplate.Range("b55:g63").Value2 For i = 1 To UBound(PartII, 1) If Len(PartII(i, 1)) Then dic.Item(PartII(i, 1)) = i Next If IsArray(AirC) Then wksCSV1.Rows(1).Insert wksCSV1.Columns(11).Insert wksCSV1.Cells(1, 11) = "temp" wksCSV1.UsedRange.Rows(1) = "temp" wksCSV2.Rows(1).Insert wksCSV2.Columns(5).Insert wksCSV2.Cells(1, 5) = "temp" wksCSV2.UsedRange.Rows(1) = "temp" rngTemplate.Copy rngDest.PasteSpecial 8: Application.CutCopyMode = False For i = LBound(AirC) To UBound(AirC) rngTemplate.Copy rngDest Union(rngDest.Cells(6, 18), rngDest.Cells(52, 3)) = "AIRLINE" & i + 1 & "-(" & AirC(i) & ")" With wksCSV1.UsedRange.Resize(, 21) .AutoFilter 1, AirC(i) Set rngCopy = .Cells(1, 3).Offset(1).Resize(.Rows.Count - 1, .Columns.Count - 2).SpecialCells(12) rngCopy.Copy rngDest.Cells(23, 2).PasteSpecial -4163 Application.CutCopyMode = False .AutoFilter End With Set rngCopy = Nothing With wksCSV2.UsedRange.Resize(, 7) .AutoFilter 1, AirC(i) Set rngCopy = .Cells(1, 4).Offset(1).Resize(.Rows.Count - 1, .Columns.Count - 3).SpecialCells(12) For r = 1 To rngCopy.Rows.Count t = dic.Item(rngCopy.Cells(r, 1).Value) If Not IsEmpty(t) Then For c = 2 To rngCopy.Columns.Count rngDest.Cells(54 + t, c + 1) = rngCopy.Cells(r, c).Value Next End If Next .AutoFilter End With Set rngCopy = Nothing rngDest.Rows(53).RowHeight = 50 On Error Resume Next rngDest.Cells(23, 2).Resize(27).SpecialCells(4).EntireRow.Delete On Error GoTo 0 Set rngDest = wksResult.Range("b" & wksResult.Rows.Count).End(xlUp).Offset(3, -1) wksResult.HPageBreaks.Add rngDest Next wksCSV1.Columns(11).Delete wksCSV1.Rows(1).Delete wksCSV2.Columns(5).Delete wksCSV2.Rows(1).Delete ElseIf Not IsEmpty(AirC) Then wksCSV1.Columns(11).Insert wksCSV5.Columns(5).Insert rngTemplate.Copy rngDest Union(rngDest.Cells(6, 18), rngDest.Cells(52, 3)) = "AIRLINE" & i + 1 & "-(" & AirC(i) & ")" With wksCSV1.Range("a1").CurrentRegion .AutoFilter 1, AirC(i) Set rngCopy = .Cells(1, 3).Offset(1).Resize(.Rows.Count - 1, .Columns.Count - 2).SpecialCells(12) rngCopy.Copy rngDest.Cells(2, 23).PasteSpecial -4163 Application.CutCopyMode = False .AutoFilter End With Set rngCopy = Nothing With wksCSV2.Range("a1").CurrentRegion .AutoFilter 1, AirC(i) Set rngCopy = .Cells(1, 4).Offset(1).Resize(.Rows.Count - 1, .Columns.Count - 3).SpecialCells(12) For r = 1 To rngCopy.Rows.Count t = dic.Item(rngCopy.Cells(r, 1).Value) If Not IsEmpty(t) Then For c = 2 To rngCopy.Columns.Count rngDest.Cells(54 + t, c + 1) = rngCopy.Cells(r, c).Value Next End If Next .AutoFilter End With Set rngCopy = Nothing rngDest.Rows(53).RowHeight = 50 On Error Resume Next rngDest.Cells(23, 2).Resize(27).SpecialCells(4).EntireRow.Delete On Error GoTo 0 Set rngDest = wksResult.Range("b" & wksResult.Rows.Count).End(xlUp).Offset(2) wksResult.HPageBreaks.Add rngDest wksCSV1.Columns(11).Delete wksCSV2.Columns(5).Delete End If Application.ScreenUpdating = 1End SubPrivate Function UNIQUE(ByRef d) If TypeOf d Is Range Then d = d.Value2 Dim i As Long With CreateObject("scripting.dictionary") .comparemode = 1 For i = 1 To UBound(d, 1) If Len(d(i, 1)) Then .Item(d(i, 1)) = Empty Next If .Count Then UNIQUE = .keys End WithEnd Function
Kris, this is great, thank you. Is there a way we can make one page per airline? Right now the output for one airline is spread among, it looks like in the Print Preview, 6 pages. Other than that, it looks fantastic! Great job! Thanks!
I have attached the file again that ran with your code. Also attached is the updated macro code (this was one very tiny mistake in your macro code that I fixed, you had called the second tab CSV5 instead of CSV2, no worries, I fixed and it ran). ExpertsExchange-Question-20.xlsm ExpertsExchange-Question-20Updat.docx
krishnakrkc
add these lines at the end of the code(before application.scr...)
Kris, very good, thank you. At first I was little confused by what you were trying to accomplish but then I realized where I was.
My last request is that the Airline Name is not actually "AIRLINE1", "AIRLINE2", etc. but instead actually United States airline carriers such as "Delta Airlines", "American Airlines", etc. When using Experts-Exchange, I cannot provide the actual name of the airline carriers so I just use dummy airline names. Next time I will use different 'fake' airline names for the Experts to understand.
Other than that, everything works! Great job. Thank you.
try this
Open in new window
Kris