Excel VBA sum all cells with matching criteria - vba

I've been trying to do an Overall Equipment Effectiveness (OEE), and for that I need to be able to sum all the good produced items and divide over the total production. So i get a quality índex...
The criteria are "today" , shift (1 or 2 or 3 ) , piece number
So far I've done this...
Private Sub CommandButton1_Click()
Dim last, i As Integer
Dim ref As String, turno As String, dia As String, estado As String, pecasap As String, pecaspr As String
'Sheets("analisegeral").Select
folha = estadoform.Label1.Caption
last = Application.ThisWorkbook.Worksheets(folha).Range("A65536").End(xlUp).Row
Application.ThisWorkbook.Worksheets(folha).Cells(last + 1, 5) = fimturnoform.ComboBox1 'peça
Application.ThisWorkbook.Worksheets(folha).Cells(last + 1, 6) = "FIM TURNO"
Application.ThisWorkbook.Worksheets(folha).Cells(last + 1, 7) = "FINALIZADO" 'estado trabalho (A DECORRER/FINALIZADO)
Application.ThisWorkbook.Worksheets(folha).Cells(last + 1, 9) = fimturnoform.TextBox1.Text 'fase
Application.ThisWorkbook.Worksheets(folha).Cells(last + 1, 12) = Now() 'HORA FIM TURNO
Application.ThisWorkbook.Worksheets(folha).Cells(last + 1, 14) = fimturnoform.TextBox3.Text 'peças aprovadas
Application.ThisWorkbook.Worksheets(folha).Cells(last + 1, 15) = fimturnoform.TextBox2.Text 'peças produzidas
'' Day (Now)
For i = 2 To last
dia = Cells(i, 3)
turno = Cells(i, 4)
ref = Cells(i, 5)
estado = Cells(i, 6)
pecasap
pecaspr
If (Day(Now) = dia And ComboBox2 = turno And ComboBox1 = ref And (estado = "FIM LOTE" Or estado = "FIM TURNO")) Then
End If
Next i
GoTo fim
fim:
End Sub

Related

vb.net chart: How to get AxisX.CustomLabels in sync with AxisX.MajorTickMark

As shown in the code, I get CustomLabels displayed, but they are not on the MajorTickMarks defined in the ChartArea. How do I get this in sync?
vb.net
Dim from_X, to_X As Date
from_X = myClass.get_DateOfWeek(CInt(yearkNo), CInt(weekNo), DayOfWeek.Monday)
'Last week from mainTable
weekNo = mainTable.Columns(mainTable.Columns.Count - 1).ColumnName.Split(CChar("/"))(0).Substring(2, 2)
yearkNo = mainTable.Columns(mainTable.Columns.Count - 1).ColumnName.Split(CChar("/"))(1).Substring(0, 4)
to_X = myClass.get_DateOfWeek(CInt(yearkNo), CInt(weekNo), DayOfWeek.Saturday)
Dim ints as integer = CInt(DateDiff(DateInterval.WeekOfYear, from_X, to_X, FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFullWeek))
Dim xdate(ints) As Date 'is looped through and the date of the respective week is added.
newchart(chart1) 'create new chart
Dim chartArea1 As New ChartArea("Default")
chart1.ChartAreas.Add(chartArea1)
chart1.ChartAreas("Default").AxisX.IntervalType = DateTimeIntervalType.Weeks
chart1.ChartAreas("Default").AxisX.Interval = 1
chart1.ChartAreas("Default").AxisX.LabelAutoFitStyle = LabelAutoFitStyles.DecreaseFont
chart1.ChartAreas("Default").AxisX.LabelAutoFitMinFontSize = 7
chart1.ChartAreas("Default").AxisX.LabelStyle.Font = My.Settings.fontbold8
chart1.ChartAreas("Default").AxisX.LabelStyle.Angle = 90
chart1.ChartAreas("Default").AxisX.MajorTickMark.Enabled = True
chart1.ChartAreas("Default").AxisX.MinorTickMark.Enabled = False
chart1.ChartAreas("Default").AxisX.Minimum = from_X.ToOADate()'44443
chart1.ChartAreas("Default").AxisX.Maximum = to_X.ToOADate()'44828
chart1.ChartAreas("Default").AxisX.IsMarginVisible = False
chart1.Series.Add("K").Color = ColorTranslator.FromHtml("#297AB7") 'MattBlau colorx(0)
chart1.Series("K").Points.DataBindXY(xdate, yValues)
chart1.ChartAreas("Default").AxisX.CustomLabels.Clear()
For intVal As Integer = 0 To ints - 1
Debug.Print(intVal & " - " & Format(xdate(intVal), "yyyy-MM-dd"))
Select Case intVal
Case 0, 5, 10, 15, 20, ints - 2
chart1.ChartAreas("Default").AxisX.CustomLabels.Add(xdate(intVal).ToOADate(), xdate(ints - 1).ToOADate(), myClass.get_WeekNumber(xdate(intVal)) & "/" & xdate(intVal).Year)
End Select
Next
It looks now like here in the picture:
https://www.spearhead-home.com/Downloads/20220517_XAchseKWs.jpg
Found now a solution for me:
AxisX.IntervalType, AxisX.Minimum, AxisX.Maximum must match the series DataBindXY(xValues, yValues)
Dim ints as integer = CInt(DateDiff(DateInterval.WeekOfYear, von_X, bis_X, _
FirstDayOfWeek.Monday, FirstWeekOfYear.FirstFullWeek))
Dim xdate(ints) As Date 'is looped through and the date of the respective week is added.
Dim xInt(ints) As Integer 'is looped through and the numbers of the interval-count added.
chart1.ChartAreas("Default").AxisX.IntervalType = DateTimeIntervalType.NotSet
chart1.ChartAreas("Default").AxisX.Interval = 1
chart1.ChartAreas("Default").AxisX.Minimum = 0
chart1.ChartAreas("Default").AxisX.Maximum = ints - 1
chart1.ChartAreas("Default").AxisX.CustomLabels.Clear()
For intVal As Integer = 0 To ints - 1
Dim kw_run As String = ""
kw_run = myClass.set_WeekFormat(myClass.get_WeekNumber(xdate(intVal)), xdate( _
intVal), True)
'result looks like: 2022/20
chart1.ChartAreas("Default").AxisX.CustomLabels.Add(intVal, intVal + 1, kw_run, _
0, LabelMarkStyle.None)
Next
'Series
chart1.Series("mySeries").Points.DataBindXY(xInt, yValues)
'...

How do I properly add items in a multilistbox?

I'm using vba to fetch equipment numbers and their corresponding information and putting them in a listbox. A user will enter in the equipment number they want and excel will fetch the info. However, when I click my 'Get Data' button the first time it works ok. When i do it the second time for another equipment number I get the message "Could not set the List property. Invalid property array index." Here's my code:
Dim value As Long
Public i As Integer
Private Sub GetDataButton_Click()
Dim num As Variant
value = EquipmentNumber.value
For Each num In Sheets("S1 Cvtg Eqt List").Range(Range("B1"), Range("B1").End(xlDown))
If num = value Then
MWOList.AddItem (num)
MWOList.List(i, 1) = (num.Offset(0, 1))
MWOList.List(i, 2) = (num.Offset(0, 2))
MWOList.List(i, 3) = (num.Offset(0, 3))
MWOList.List(i, 4) = (num.Offset(0, 4))
MWOList.List(i, 5) = (num.Offset(0, 5))
i = i + 1
End If
Next num
i = i + 1
End Sub
Try below, please note that I had changed not only "i" declaration, and value to public, but also the List column position starts from 0, so if this is 6 element table, then switch it back.
The reason you had error was in fact another "i" iteration "i=i+1" after the loop, the list rows also start from 0, therefore you added 2nd index, and tried to insert it on the third position.
Public value As Long
Public i As Integer
Private Sub GetDataButton_Click()
Dim num As Variant
value = EquipmentNumber.value
For Each num In Sheets("S1 Cvtg Eqt List").Range(Range("B1"), Range("B1").End(xlDown))
If num = value Then
i = MWOList.ListCount 'set i to available space
MWOList.AddItem
MWOList.List(i, 0) = (num.Offset(0, 1))
MWOList.List(i, 1) = (num.Offset(0, 2))
MWOList.List(i, 2) = (num.Offset(0, 3))
MWOList.List(i, 3) = (num.Offset(0, 4))
MWOList.List(i, 4) = (num.Offset(0, 5))
End If
Next num
EquipmentNumber = ""
End Sub

VBA USER FORM error 6 work around

I currently have a bunch of Combo boxes that has a option for Yes, No or N/A
Then I Have a Command button that that runs a calculation then moves to the next page
Private Sub CommandButton2_Click()
Dim a As Long, b As Long
a = IIf(Cbx1_1.Value = "Yes", 1, 0) + IIf(Cbx1_2.Value = "Yes", 1, 0) +_
IIf(Cbx1_3.Value = "Yes", 1, 0) + IIf(Cbx1_4.Value = "Yes", 1, 0)
b = 4 - IIf(Cbx1_1.Value = "N/A", 1, 0) - IIf(Cbx1_2.Value = "N/A", 1, 0)_
- IIf(Cbx1_3.Value = "N/A", 1, 0) - IIf(Cbx1_4.Value = "N/A", 1, 0)
OUTBX1.Text = Format(a / b, "00.00%")
MultiPage1.Value = 1
End Sub
Now the Only Problem that I am experiencing now is that if all the boxes are check as "N/A" then I get the 0/0 problem (Error 6 : Overflow)
I know that with Excel I would have used an ERRORIF formula to solve this. Is there a way that I can tell VBA that if:
=ERRORIF (b=0) then MultiPage1.Value = 1 else
OUTBX1.Text = Format(a / b, "00.00%")
Thank you to everyone for you help the final answer to this is coded as following:
Private Sub CommandButton2_Click()
Dim a As Long, b As Long
a = IIf(Cbx1_1.Value = "Yes", 1, 0) + IIf(Cbx1_2.Value = "Yes", 1, 0) + IIf(Cbx1_3.Value = "Yes", 1, 0) + IIf(Cbx1_4.Value = "Yes", 1, 0)
b = 4 - IIf(Cbx1_1.Value = "N/A", 1, 0) - IIf(Cbx1_2.Value = "N/A", 1, 0) - IIf(Cbx1_3.Value = "N/A", 1, 0) - IIf(Cbx1_4.Value = "N/A", 1, 0)
If b = 0 Then
MultiPage1.Value = 1
Else
OUTBX1.Text = Format(a / b, "00.00%")
MultiPage1.Value = 1
End If
End Sub

How i can use a criteria in cicle for i

i want to use a criteria in my loop
but not work
UR = 3
ReDim arng(UR, 3) As Variant
For X = 0 To UR
arng(X, 0) = ConvDate(Cells(X , 8))
arng(X, 1) = ConvDate(Cells(X , 12))
arng(X, 2) = Iif(Cells(X , 12) = "", MsgBox("empty"), MsgBox("Full"))
Next X
even if the cell(X,12) is actually empty both messages show
Why?!?!?
isn't possible to use a criteria??
thank
Worked over a lil bit, try this
dim UR as integer
UR = 3
ReDim arng(UR, 3) As Variant
For X = 0 To UR
arng(X, 0) = ConvDate(Cells(X , 8))
arng(X, 1) = ConvDate(Cells(X , 12))
if Cells(X , 12) = "" then
MsgBox("empty")
else
msgbox("full")
end if
Next X

EDI file without any third party tool

i am getting EDI file as shown below,i need to process it ,and i need to maintain primary key ,foreign key also.
TH*4.2*857463*01**20091015*1045*P**~~IS*7564*ACME
PHARMACY~PHA*1234567890~PAT*MA*06*987544****SMITH*JOHN****1234 MAIN
ST**SOMEWHERE*MA*54356**19500101*M*01*01*INDIA**BURGER~
Here the column delimeter is * ,also if no value is provided they also put *.
i need to store fields from
TH*4.2*857463*01**20091015*1045*P**~~
into 1 table,by seperating fields.
So it would be
th01 th02 th03 th04 th05 th06 th07 th08 th09 th10
TH 4.2 857163 01 *(no value) 20091015 1045 p * (novalue) ~~
IS*7564*ACME PHARMACY into another table,and so on.
i cannot use third party tool as i cannot have xml files
Any help?
ok.
here is my vb.net code
Public Enum Segments
TH
PHA
PAT
IS1
End Enum
Dim arrLine As String()
Dim segmentcode As String
Dim counter As Integer
Dim linenumber As Integer = 1
Dim segmenetsequence As Hashtable = New Hashtable()
Dim setid As Guid = Guid.NewGuid()
Public Overrides Sub Input0_ProcessInputRow(ByVal Row As Input0Buffer)
arrLine = Row.LineText.Split("*"c)
segmentcode = SegmentValue(arrLine, 0)
Row.LineNumber = linenumber
Row.Setid = setid
counter = arrLine.Length
linenumber += 1
Select Case (segmentcode.ToUpper())
Case Segments.TH.ToString.ToUpper()
Row.TH01 = SegmentValue(arrLine, 1)
Row.TH02 = SegmentValue(arrLine, 2)
Row.TH03 = Convert.ToInt32(SegmentValue(arrLine, 3))
Row.TH04 = SegmentValue(arrLine, 4)
Row.TH05 = Convert.ToDateTime(SegmentValue(arrLine, 5))
Row.TH06 = SegmentValue(arrLine, 6)
Row.TH07 = SegmentValue(arrLine, 7)
Row.TH08 = Convert.ToInt32(SegmentValue(arrLine, 8))
Row.TH09 = SegmentValue(arrLine, 9)
Case Segments.IS1.ToString.ToUpper()
Row.IS01 = SegmentValue(arrLine, 1)
Row.IS02 = SegmentValue(arrLine, 2)
Row.IS03 = SegmentValue(arrLine, 3)
Case Segments.PHA.ToString.ToUpper()
Row.PHA01 = SegmentValue(arrLine, 1)
Row.PHA02 = SegmentValue(arrLine, 2)
Row.PHA03 = SegmentValue(arrLine, 3)
Row.PHA04 = SegmentValue(arrLine, 4)
Row.PHA05 = SegmentValue(arrLine, 5)
Row.PHA06 = SegmentValue(arrLine, 6)
Row.PHA07 = SegmentValue(arrLine, 7)
Row.PHA08 = SegmentValue(arrLine, 8)
Row.PHA09 = SegmentValue(arrLine, 9)
Row.PHA10 = SegmentValue(arrLine, 10)
Row.PHA11 = SegmentValue(arrLine, 11)
Row.PHA12 = SegmentValue(arrLine, 12)
Case Segments.PAT.ToString.ToUpper()
Row.PAT01 = SegmentValue(arrLine, 1)
Row.PAT02 = SegmentValue(arrLine, 2)
Row.PAT03 = SegmentValue(arrLine, 3)
Row.PAT04 = SegmentValue(arrLine, 4)
Row.PAT05 = Convert.ToInt32(SegmentValue(arrLine, 5))
Row.PAT06 = SegmentValue(arrLine, 6)
Row.PAT07 = SegmentValue(arrLine, 7)
Row.PAT08 = SegmentValue(arrLine, 8)
Row.PAT09 = SegmentValue(arrLine, 9)
Row.PAT10 = SegmentValue(arrLine, 10)
Row.PAT11 = SegmentValue(arrLine, 11)
Row.PAT12 = SegmentValue(arrLine, 12)
Row.PAT13 = SegmentValue(arrLine, 13)
Row.PAT14 = SegmentValue(arrLine, 14)
Row.PAT15 = SegmentValue(arrLine, 15)
Row.PAT16 = SegmentValue(arrLine, 16)
Row.PAT17 = SegmentValue(arrLine, 17)
Row.PAT18 = Convert.ToDateTime(SegmentValue(arrLine, 18))
Row.PAT19 = SegmentValue(arrLine, 19)
Row.PAT20 = Convert.ToInt32(SegmentValue(arrLine, 20))
Row.PAT21 = Convert.ToInt32(SegmentValue(arrLine, 21))
Row.PAT22 = SegmentValue(arrLine, 22)
Row.PAT23 = SegmentValue(arrLine, 23)
Row.PAT24 = SegmentValue(arrLine, 24)
End Select
End Sub
Public Function SegmentValue(ByRef LineArray As String(), ByVal Counter As Integer) As String
Throw New NotImplementedException
If LineArray.Length > Counter Then
Return LineArray(Counter).ToString().Trim()
End If
Return String.Empty
End Function
End Class
Speaking in broad terms, I would look at using a Script Component as a source. It would have an output collection per "thing" the file could contain. In your example, you'd have Output 0 with sufficient columns to describe the th rows above. You'd then have an Output 1 collection that describes the IS data set. You'll also need to factor in any keys, possibly surrogate keys generated within the source component to keep track of your data.
Once you've defined the all the columns in the collections, then it's a simple matter of writing the parsing logic in C#/VB.NET. Once parsed, you simply assign values into those collections.
Output0Buffer.AddRow();
// use this to assign a value
Output0Buffer.MyColumn = parsedValue;
// Use this for handling a null value
Output0Buffer.MyColumn_IsNull = true;
Now you can run the package and parsed data flows down the stream.
It sounds like you have foreign keys to be satisfied and surrogate values to be generated. If that is the case, I'd write most, if not all this data into a variety of staging tables and then proceed with validation and backfilling of data through repeated queries via Execute SQL Tasks chained to the Data Flow Task.
Need more detail? Edit your question and provide some yourself. We're all happy to give advice and direction but we are not in your cube and do not understand your needs.