Solved

Parsing data in an Import file into a summary tab

Posted on 2016-08-30
6
64 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 21

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 29

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
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 
LVL 29

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 500 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 29

Expert Comment

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

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

825 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