I have a question about how to achieve my goal. I am trying to get data in a format that I can use with Minitab via Excel VBA macro. Basically, I have test data from a machine, and that collects various attribute and variable data. I am interested in finding the number of items that meet several criteria, and counting that number. So, more specifically, in my 1stTimeYield column, I want to count each serial number that has a '1' entered (failures start with 'X'), for each date that is shown. Looking at the screenshot below, for 01-Feb-15, I should get a total number of 3 for my count. I also need to count the total number of serial numbers for this date, which in this case is 4. My goal is to get to the first pass yield, of 75% for the 5 data collections on Feb 1. I then need to enter this data into the respective rows/columns on the worksheet that I create in my code (I will paste the code below this text). The pasting of the counts I come up with should be relatively straight forward, after finding a way to compare the date I collected the counts for with the dates listed in the sheet that I make. Please ask clarification questions if you have them. Essentially, I am a little stumped as to how to efficiently and effectively get the data that I need by date.
Sub Main()
Dim iNumSheets As Long
'Add new Worksheet; check if exists already
Sheets.Add After:=Sheets(Sheets.Count)
iNumSheets = Sheets.Count
If SheetExist("FPY Data") Then
Application.DisplayAlerts = False
Sheets(iNumSheets).Delete
Application.DisplayAlerts = True
End
Else
Sheets(iNumSheets).Name = "FPY Data"
End If
'Create and Format the Date and Yield Comments
Dim sDate As String
Dim sYield As String
Sheets("FPY Data").Select
Cells(1, 1).Value = "Date"
Cells(1, 2).Value = "First Pass"
Cells(1, 3).Value = "Total Pass"
Cells(1, 4).Value = "FPY (%)"
Columns("A:A").ColumnWidth = 10.33
Columns("B:B").ColumnWidth = 10.33
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(1, 1).Select
'Find Dates and copy to Yield Worksheet
Dim iRow As Long
Dim wSheet As Worksheet
Set wSheet = ThisWorkbook.Worksheets(1)
iRow = wSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Copy first date in data
Dim iTemp As Long
iTemp = 3
Worksheets("FPY Data").Cells(2, 1).Value = Worksheets(1).Cells(2, 2).Value
For iCounter = 3 To iRow 'Loop through data for dates
If Worksheets(1).Cells(iCounter, 2).Value = Worksheets(1).Cells(iCounter - 1, 2).Value Then
'Do not copy new date to FPY data
Else
'Copy Date to next available cell & increment counter
Worksheets("FPY Data").Cells(iTemp, 1).Value = Worksheets(1).Cells(iCounter, 2).Value
iTemp = iTemp + 1
End If
Next iCounter
'Count number of First Time Passes
End Sub
Function SheetExist(strSheetName As String) As Boolean
Dim i As Integer
For i = 1 To Worksheets.Count
If Worksheets(i).Name = strSheetName Then
SheetExist = True
Exit Function
End If
Next i
End Function
I understand that you have been working on a VBA solution but if formulas will do, some efficient non-array standard formulas can be applied to achieve your results¹.
The first thing you need are a list of unique dates. Excel treats dates as numbers so you can retrieve a ranked unique list starting with this formula in F2,
=SMALL($B:$B, COUNTIF($B:$B, "<="&$F1)+1)
Next is a COUNTIFS function that takes all of your conditrions into consideration in G2.
=COUNTIFS($B:$B, $F2,$D:$D, 1,$C:$C, "<>X*")
Your heavily redacted data left the question of the serial number column containing duplicates unanswered so I assumed that there may be duplicates. H2's formula is,
=SUMPRODUCT(($B$2:$B$9999=$F2)/COUNTIF($C$2:$C$9999, $C$2:$C$9999&""))
Your narrative was unclear on whether that count should contain the serial numbers starting with X so here is the same count with X's excluded in I2,
=SUMPRODUCT((($B$2:$B$9999=$F2)*(LEFT($C$2:$C$9999,1)<>"X"))/COUNTIF($C$2:$C$9999,$C$2:$C$9999&""))
Fill down as necessary. When you run out of dates to pull into column F you will get a #REF!
error. Stop filling down there.
¹ fwiw, if I did this in VBA, I'd be using Application.WorksheetFunction to mash up several of these functions into the VBA code both for code efficiency and expediency.
'Find Last Row of FPY Data Worksheet
Set wSheet = ThisWorkbook.Worksheets("FPY Data")
'Fill First Pass Column
Cells(2, 2).Activate
ActiveCell.FormulaR1C1 = "=COUNTIFS(PartData!C,'FPY Data'!RC[-1],PartData!C[20],1,PartData!C[1],""<>X*"")"
iRow = wSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & iRow - 1)
'Fill Total Pass Column
Cells(2, 3).Activate
ActiveCell.FormulaR1C1 = "=COUNTIFS(PartData!C[-1],'FPY Data'!C[-2],PartData!C,""<>X*"")"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & iRow - 1)
'Fill Percentage field
Cells(2, 4).Activate
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]*100"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & iRow - 1)
Range(Cells(2, 4), Cells(iRow, 4)).Select
Selection.NumberFormat = "0.00"
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.