Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Parsing data in an Import file into a summary tab

Posted on 2016-08-30
6
Medium Priority
?
76 Views
Last Modified: 2016-09-01
I have an import file that is generated everyday that lists specific work cards that must be performed on 1 of 17 vehicles.  The required vehicles are contained in 1 cell separated by ";" (e.g. #Car1;#Car2;#Car3 ...etc).

I would like to create VBA that creates a tab similar to the Summary sheet in the attached workbook.  Because of the way the data arrives I was not able to create a Pivot table to solve my problem.

Import File:
ID      Category      Group      Work Card#      Hours per Car      Impacted Vehicles
1      1- LevelA      Exterior      X187                   5                                #Car1;#Car2;#Car3;#Car4;#Car5;#Car6;#Car7
2      2-LevelB        Exterior      X897                 15                                #Car2;#Car3;#Car5;#Car6
3      3-LevelC       Interior      X754                 20                                #Car1;#Car5;#Car6;#Car7
4      2-LevelB              Interior      X777                 30                              #Car1;#Car2;#Car3;#Car5;#Car7

Desired Output: (R= Required)
Work Card#      Hours per Car      Car1      Car2      Car3      Car4      Car5
X187                 5                                  R                 R                 R                  R                 R
X897                15                                               R                 R                               R
X754                20                                  R                                                           R
X777                30                                  R                 R                 R                               R
                      Total Hours                100      95                 95           50               115


Thanks for your help.
WorkCard-Sample.xlsx
0
Comment
Question by:robbdfw
  • 3
  • 2
6 Comments
 
LVL 23

Expert Comment

by:Ejgil Hedegaard
ID: 41777185
VBA is a possible solution, but it is also possible with formulas.
Check sheet.
WorkCard-Sample.xlsx
0
 
LVL 33

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41777194
Please try this.....
In the attached click the button "Create Summary" on the Import Sheet to get the desired output in newly created sheet called Summary.

Sub CreateMatrixSummary()
Dim sws As Worksheet, dws As Worksheet
Dim slr As Long, dlr As Long, r As Long
Dim dRng As Range, dCell As Range, wCell As Range, cell As Range
Dim x() As String
Dim tbl As ListObject

Application.ScreenUpdating = False
Set sws = Sheets("Import")
Set tbl = sws.ListObjects("Table_owssvr")
On Error Resume Next
Set dws = Sheets("Summary")
dws.Cells.Clear
On Error GoTo 0
If dws Is Nothing Then
   Sheets.Add(after:=sws).Name = "Summary"
   Set dws = ActiveSheet
End If
With dws.Range("A1")
   .Value = "Work Card Matrix Summary"
   .Font.Bold = True
End With
tbl.Range.Columns("D:F").Copy dws.Range("A3")
dws.Cells.WrapText = False
dws.Range("C3").Value = "Car1"
dws.Range("C3").AutoFill dws.Range("C3:S3"), xlFillDefault
With dws.Range("C3:S3")
   .Interior.Color = RGB(91, 155, 213)
   .Font.Color = vbWhite
End With
dlr = dws.Cells(Rows.Count, 1).End(xlUp).Row
Set dRng = dws.Range("A4:A" & dlr)
For Each dCell In dRng
   dCell.Offset(0, 2).Replace "#", ""
   x() = Split(dCell.Offset(0, 2), ";")
   dCell.Offset(0, 2) = ""
   For i = 0 To UBound(x)
      For Each cell In dws.Range("C3:S3")
         If cell = x(i) Then
            dws.Cells(dCell.Row, cell.Column) = "R"
            Exit For
         End If
      Next cell
   Next i
Next dCell
Range("C4:C" & dlr).Interior.ColorIndex = xlNone
Range("C4:C" & dlr).Borders.ColorIndex = xlNone
With dws.Range("B" & dlr + 2)
   .Value = "Total Hours"
   .Font.Bold = True
End With
For i = 3 To 19
   If Application.CountA(dws.Range(dws.Cells(4, i), dws.Cells(dlr, i))) > 0 Then
      dws.Cells(dlr + 2, i).Value = WorksheetFunction.SumIf(dws.Range(dws.Cells(4, i), dws.Cells(dlr, i)), "R", dws.Range("B4:B" & dlr))
   End If
Next i
With dws.Range("C" & dlr + 2 & ":S" & dlr + 2)
   .Interior.Color = RGB(191, 191, 191)
   .Borders.Color = vbBlack
End With
dws.Columns("A:B").AutoFit
dws.Activate
Application.ScreenUpdating = True
MsgBox "Summary has been created successfully.", vbInformation, "Done!"
End Sub

Open in new window

WorkCard-Sample.xlsm
0
 

Author Comment

by:robbdfw
ID: 41778711
That worked perfectly.  I do have one additional question.  I just learned that my import file may have an additional column called "Status" and anything with a value of "Closed" would need to be excluded from the final output.  

Is there a way to filter out anything that would show up in a new column called status with a value of "closed" in this part of your code (Assuming the new status column is column G)?

tbl.Range.Columns("D:F").Copy dws.Range("A3")
0
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!

 
LVL 33

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 2000 total points
ID: 41778737
Okay. Please find the attached where I have added one more column in the Table on Import Sheet called Status and let me know if that is what you were trying to achieve.
WorkCard-Sample-v2.xlsm
0
 

Author Closing Comment

by:robbdfw
ID: 41779979
Thank you once again. Always a pleasure to work with you.
0
 
LVL 33

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41779990
You're welcome Robbdfw! Glad to help.
Thanks for the feedback.
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Explore the ways to Unlock VBA Project Password Excel 2010 & 2013 documents. Go through the article and perform the steps carefully to remove VBA Excel .xls file.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

885 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question