VBA Excel Find data in table on different sheet - mysql

I have two worksheets, Receiving and Order Archive, both of which have tables on them with the same headers: sku, qty, Patient Name, Product Info, Vendor, L/R, Clinician, Date Ordered, PO Number, Received, Cost
.
I'm trying to write a macro that starts on receiving page table, and pulls all the rows found on the Order Archive sheet table named "OrderArchive", copies that row information onto "Receiving" table. However I only want it to pull ones that are designated in the Received column as "[Pending]".

Usually don't like to hand code out without any effort on your end, but give this a try and let me know if it's what you're looking for:
'I named the Receiving tab's table "receivingTable"
'I named the Order Archive tab's table "orderArchiveTable"
Dim cnt As Integer
Dim x As Integer
Dim y As Integer
Dim cntPending As Integer
Dim myArray() As Variant
'count number of rows that are in orderArchiveTable
cnt = Range("orderArchiveTable").Rows.Count
'Scan orderArchiveTable for 'Pending' Orders in the 'Received' column
cntPending = 0
For x = 1 To cnt
'count number of row that are Pending to use for array size
If Range("orderArchiveTable[Received]")(x).Value = "Pending" Then
cntPending = cntPending + 1
End If
Next x
If cntPending = 0 Then Exit Sub 'no pending orders
'ReDim array for correct size... remember that it starts at zero! NOT 1
ReDim myArray(cntPending - 1, 9)
'Fill array with values
y = 0
For x = 1 To cnt
If Range("orderArchiveTable[Received]")(x).Value = "Pending" Then
myArray(y, 0) = Range("orderArchiveTable[sku]")(x).Value
myArray(y, 1) = Range("orderArchiveTable[qty]")(x).Value
myArray(y, 2) = Range("orderArchiveTable[Patient Name]")(x).Value
myArray(y, 3) = Range("orderArchiveTable[Vendor]")(x).Value
myArray(y, 4) = Range("orderArchiveTable[L/R]")(x).Value
myArray(y, 5) = Range("orderArchiveTable[Clinician]")(x).Value
myArray(y, 6) = Range("orderArchiveTable[Date Ordered]")(x).Value
myArray(y, 7) = Range("orderArchiveTable[PO Number]")(x).Value
myArray(y, 8) = Range("orderArchiveTable[Received]")(x).Value
myArray(y, 9) = Range("orderArchiveTable[Cost]")(x).Value
'Not sure if you want to delete the rows taken, but you would do this here and subtract 1 from x and cnt
Selection.ListObject.ListRows(x).Delete
x = x - 1
cnt = cnt - 1
'go to next row in array
y = y + 1
End If
Next x
'count number of rows that are in receivingTable
cnt = Range("receivingTable").Rows.Count + 1
'Dump array into receivingTable
For x = 0 To UBound(myArray)
Set NewRow = Range("receivingTable").ListObject.ListRows.Add(AlwaysInsert:=True)
Range("receivingTable[sku]")(cnt + x).Value = myArray(x, 0)
Range("receivingTable[qty]")(cnt + x).Value = myArray(x, 1)
Range("receivingTable[Patient Name]")(cnt + x).Value = myArray(x, 2)
Range("receivingTable[Vendor]")(cnt + x).Value = myArray(x, 3)
Range("receivingTable[L/R]")(cnt + x).Value = myArray(x, 4)
Range("receivingTable[Clinician]")(cnt + x).Value = myArray(x, 5)
Range("receivingTable[Date Ordered]")(cnt + x).Value = myArray(x, 6)
Range("receivingTable[PO Number]")(cnt + x).Value = myArray(x, 7)
Range("receivingTable[Received]")(cnt + x).Value = myArray(x, 8)
Range("receivingTable[Cost]")(cnt + x).Value = myArray(x, 9)
Next x

Related

How to add new Access record by checkbox and number of different date?

I have query 1 or table 1 have the below data
Number of employee/start date/end date/code/different date by Days/checkbox
Example
200/01-01-2021/15-01-2021/E/14/Yes
I need when checkbox=Yes to open 14 record automatically in new table 2 with code like below:
employee/date/code
200/01-01-2021/E
200/02-01-2021/E
200/03-01-2021/E
200/04-01-2021/E
200/05-01-2021/E
200/06-01-2021/E
200/07-01-2021/E
200/08-01-2021/E
200/09-01-2021/E
200/10-01-2021/E
200/11-01-2021/E
200/12-01-2021/E
200/13-01-2021/E
200/14-01-2021/E
Extract your parameters:
Data = "200/01-01-2021/15-01-2021/E/14/Yes"
ENo = Split(Data, "/")(0)
FirstDate = DateValue(Split(Data, "/")(1))
ECode = Split(Data, "/")(3)
Periods = Split(Data, "/")(4)
Then run this query passing it the parameters:
PARAMETERS
Periods Short,
FirstDate DateTime;
SELECT DISTINCT
10 * Abs([Deca].[id] Mod 10) + Abs([Uno].[id] Mod 10) + 1 AS Sequence,
ENo As Employee,
DateAdd("d", [Sequence] - 1, [FirstDate]) AS DateStart,
ECode As Code
FROM
MSysObjects AS Uno,
MSysObjects AS Deca
WHERE
(10 * Abs([Deca].[id] Mod 10) + Abs([Uno].[id] Mod 10)) < [Periods];
Output:
You can the use this query as source in an append query.
Or, alternatively, use DAO to directly append the records:
Dim Records As DAO.Recordset
Dim Index As Integer
Set Records = CurrentDb.OpenRecordset("Select * From Table2")
For Index = 0 To Periods - 1
Records.AddNew
Records!Employee.Value = Eno
Records!Date.Value = DateAdd("d", Index, FirstDate)
Records!Code.Value = ECode
Records.Update
Next
Records.Close

Join 2 tables, add first table as column headers for datagridview then add second table as rows below column headers

I want to add columns for FACILITIES and then use their fac_id to find the their water production from another table to be displayed as a single row below the column headers.
Do While tableRetrieve.Read = True
table.Columns.Add(tableRetrieve("facility"), Type.GetType("System.String"))
Dim newDate As DateTime = DateTime.ParseExact(dtpFrom.Value, "MM/dd/yyyy h:m:s tt",
System.Globalization.DateTimeFormatInfo.InvariantInfo)
Dim myDate As String = newDate.ToString("yyyy-MM-dd", System.Globalization.DateTimeFormatInfo.InvariantInfo)
If myDate = tableRetrieve("sentDate") Then
If tableRetrieve("prod_id") = tableRetrieve("fac_id") Then
table.Rows.Add(tableRetrieve("facility_produce"))
End If
End If
Loop
I can add the column headers but failed in rows.
Below is an image of the output. Column headers are displayed but the water production quantities are only displayed in one row. There should be water production quantities for each corresponding columns based on prod_id equals fac_id.
Sample of DataGridView
UPDATE:
This is what my code looks like now. This works well if there's only one row. the errors display if there's another row.
Do While tableRetrieve.Read = True
table.Columns.Add(tableRetrieve("facility"), Type.GetType("System.String"))
If tableRetrieve("facility_id") = tableRetrieve("fac_id") Then
newDate = tableRetrieve("sentDate")
If prevDate = newDate Then
table.Rows(row)(col) = tableRetrieve("facility_produce")
prevDate = newDate
col += 1
Else
If row = 0 Then
col += 1
table.Rows.Add(tableRetrieve("sentDate"))
table.Rows(row)(col) = tableRetrieve("facility_produce")
prevDate = newDate
col += 1
Else
col = 0
row += 1
table.Rows.Add(tableRetrieve("sentDate"))
table.Rows(row)(col) = tableRetrieve("facility_produce")
col += 1
End If
End If
End If
Loop
dgvFacility.DataSource = table
For each loop you write tableRetrieve("facility_produce") in new row. You should write it to next column instead.
Dim col As Integer = 0
Do While tableRetrieve.Read = True
table.Columns.Add(tableRetrieve("facility"), Type.GetType("System.String"))
Dim newDate As DateTime = DateTime.ParseExact(dtpFrom.Value, "MM/dd/yyyy h:m:s tt",
System.Globalization.DateTimeFormatInfo.InvariantInfo)
Dim myDate As String = newDate.ToString("yyyy-MM-dd", System.Globalization.DateTimeFormatInfo.InvariantInfo)
If myDate = tableRetrieve("sentDate") Then
If tableRetrieve("prod_id") = tableRetrieve("fac_id") Then
If col = 0 Then
table.Rows.Add(tableRetrieve("facility_produce"))
Else
table.Rows(0)(col) = tableRetrieve("facility_produce")
End If
col += 1
End If
End If
Loop
First things first. I added Dim countColumns As Integer in the beginning of the form to be called later to count columns.
I inserted countColumns += 1 in the part where I display a blank row datagridview but with column headers in it. There the columns that are registered in the database are already counted. So I can use it later to call the number of columns.
I then placed table.Columns.Count <= countColumns so the column count increases as the columns are displayed and then stop adding columns once the number of columns registered in the database are equal, to avoid errors on duplication.
This is the part of my program where I display the columnd headers and the row values:
Try
SQLConnection.Open()
tableRetrieve = sqlCommand.ExecuteReader
table.Columns.Add("Date", Type.GetType("System.String"))
Do While tableRetrieve.Read = True
If table.Columns.Count <= countColumns Then
table.Columns.Add(tableRetrieve("facility"), Type.GetType("System.String"))
End If
newDate = tableRetrieve("sentDate")
If prevDate = newDate Then
table.Rows(row)(col) = tableRetrieve("facility_produce")
prevDate = newDate
col += 1
Else
If col = 0 Then
col += 1
table.Rows.Add(tableRetrieve("sentDate"))
table.Rows(row)(col) = tableRetrieve("facility_produce")
prevDate = newDate
col += 1
Else
col = 1
row += 1
table.Rows.Add(tableRetrieve("sentDate"))
table.Rows(row)(col) = tableRetrieve("facility_produce")
prevDate = newDate
col += 1
End If
End If
Loop
dgvFacility.DataSource = table
tableRetrieve.Close()
sqlCommand.ExecuteNonQuery()
Catch ex As MySqlException
MsgBox(ex.Message.ToString)
Finally
SQLConnection.Close()
End Try
This part of the program checks if the dates are the same by this code: prevDate = newDate, if they are the same then the program will add the facility_produce on the same row by the corresponding column. If date not the same then the program checks if col is zero, if zero then the datagridview is still empty and the program will input the first row with its amount produced. And if col is not zero, it means there's already a new date and that there's already an existing row then the program has to input the next row of values below.
If prevDate = newDate Then
table.Rows(row)(col) = tableRetrieve("facility_produce")
prevDate = newDate
col += 1
Else
If col = 0 Then
col += 1
table.Rows.Add(tableRetrieve("sentDate"))
table.Rows(row)(col) = tableRetrieve("facility_produce")
prevDate = newDate
col += 1
Else
col = 1
row += 1
table.Rows.Add(tableRetrieve("sentDate"))
table.Rows(row)(col) = tableRetrieve("facility_produce")
prevDate = newDate
col += 1
End If
End If
Sorry for the long post, but I hope this will help and guide anyone who is using inner join and then use the row values as column headers. I had a hard time solving this. Haven't used VB programming since 2010. I was still using VB 6 way back 2010 and I am very outdated with VB.Net now. Have a lot to learn and I am enjoying it.
Thank you #milda for the help. Your code guided me in placing my values in their right positions.

SSRS Report Code: Localization converts output to es-MX but the report Language is in en-US so it comes out wrong

I have an SSRS report that uses the following code to calculate some statistics based on parameters selected by the user.
When this runs in Chrome on a machine with en-US localization, the output comes out correct.
When in Chrome in a machine with es-MX localization, the output is off because the decimal becomes a thousands separator (comma) and the thousands separator (comma) becomes a decimal.
Oddly enough, when I run in Edge on the same machine with es-MX, the output is correct.
How do I handle the localization of number formatting within the code embedded in the SSRS report?
Function GetDataSetLabelFromValue
Public function GetDataSetLabelFromValue() as decimal
dim i as integer
dim rBar as decimal
dim processSigma as decimal
dim d2 as decimal
dim restartLow as integer
restartLow = 0
d2 = 1.128
i = 0
rBar = 0.0
IF Report.Parameters!UseRestart.Value =FALSE THEN
restartLow = 0
ELSE
For i =0 to (Report.Parameters!RestartFilter.COUNT() - 1)
IF CBool(Report.Parameters!RestartFilter.Label(i)) = 0 THEN
restartLow = i + 1
END IF
Next i
END IF
IF Report.Parameters!LastBatch.Value = TRUE THEN
for i = restartLow to (Report.Parameters!PSigma.Count() - 2)
rBar = rBar + ABS(Report.Parameters!PSigma.Label(i) - Report.Parameters!PSigma.Label(i+1))
next i
ELSE
for i = restartLow to (Report.Parameters!PSigma.Count() - 3)
rBar = rBar + ABS(Report.Parameters!PSigma.Label(i) - Report.Parameters!PSigma.Label(i+1))
next i
END IF
IF (Report.Parameters!PSigma.Count() - (restartLow))=0 OR (Report.Parameters!PSigma.Count() - (restartLow) - 1)=0 THEN
rBar = 0
ELSE
IF Report.Parameters!LastBatch.Value = TRUE THEN
rBar = rBar / (Report.Parameters!PSigma.Count() - (restartLow))
ELSE
rBar = rBar / (Report.Parameters!PSigma.Count()-restartLow-1)
END IF
END IF
processSigma = rBar / d2
GetDataSetLabelFromValue = processSigma
End Function
Function GetAverageValue
Public function GetAverageValue() as decimal
dim i as integer
dim average as decimal
dim restartLow as integer
restartLow = 0
i = 0
average = 0.0
IF Report.Parameters!UseRestart.VALUE =FALSE THEN
restartLow = 0
ELSE
For i =0 to (Report.Parameters!RestartFilter.COUNT() - 1)
IF CBool(Report.Parameters!RestartFilter.Label(i)) = 0 THEN
restartLow = i + 1
END IF
Next i
END IF
IF Report.Parameters!LastBatch.Value = TRUE THEN
for i = restartLow to (Report.Parameters!PSigma.Count() - 1)
average = average + (CDEC(Report.Parameters!PSigma.Label(i)))
next i
ELSE
for i = restartLow to (Report.Parameters!PSigma.Count() - 2)
average = average + (CDEC(Report.Parameters!PSigma.Label(i)))
next i
END IF
IF (Report.Parameters!PSigma.Count() - (restartLow))=0 OR (Report.Parameters!PSigma.Count() - (restartLow) - 1)=0 THEN
average = 0
ELSE
IF Report.Parameters!LastBatch.Value = TRUE THEN
average = average / (Report.Parameters!PSigma.Count() - (restartLow))
ELSE
average = average / (Report.Parameters!PSigma.Count()-restartLow-1)
END IF
END IF
GetAverageValue = average
End Function

Chart Edition by access VBA very Slow

I use a Chart to Display Progress of Activity on ms-access 2007 with VBA, I used to work with PivotCharts wich was fast but not really editable. I need to only display the past months and make invisibles points for the rest of the year.
My Chart is display with 2 Series of 300 points (granularity increased), but I only show Data Labels once in a month.
I wasn't able to edit point by point with Pivot Chart so I moved to a classic oldStyle Chart.
My problem is that my edit is very slow, I've read about many things about VBA optimization but nothing done the trick
I measured 20 seconds for each curve it's not "acceptable" for my hierarchy.
I was thinking about multi-threading but it's way too much work for a so small benefit (%4? or %8?)
(FYI Calculation of points and so on is done before the opening of the Form and is doing great)
Here is my code of this Slow Chart Edition :
Dim intPntCount As Integer
Dim intTmp As Integer
Dim oSeries As Object
Dim colSeries As SeriesCollection
Dim oPnt As Object
Dim intCptSeries As Byte
Dim booPreviousZero As Boolean
Dim startDate, endDate As Date
Dim lngWhite, LngBlack As Long
lngWhite = RGB(255, 255, 255)
LngBlack = RGB(0, 0, 0)
linPlanned.BorderColor = RGB(251, 140, 60)
linCompleted.BorderColor = RGB(52, 84, 136)
lblUnit.Left = 1248 'use fctgetabsciisa chProgressFixs.Axes(2).MaximumScale / 80
With Me.chProgressFixs
startDate = Now
.BackColor = lngWhite
intCptSeries = 0
'colSeries = .SeriesCollection
For Each oSeries In .SeriesCollection
intCptSeries = intCptSeries + 1
Debug.Print "Series" & intCptSeries
booPreviousZero = True
intPntCount = 1
For Each oPnt In oSeries.Points
oPnt.ApplyDataLabels
If oPnt.DataLabel.Caption = "0" Then
oPnt.Border.Weight = 1
oPnt.DataLabel.Caption = vbNullString
If booPreviousZero = False Then
oPnt.Border.Color = lngWhite
booPreviousZero = True
Else
oPnt.Border.Color = LngBlack
End If
Else
booPreviousZero = False
oPnt.Border.Weight = 4
oPnt.DataLabel.Font.Size = 14
Select Case intCptSeries
Case 1: oPnt.Border.Color = linPlanned.BorderColor
Case 2: oPnt.Border.Color = linCompleted.BorderColor
End Select
If ((intPntCount + 30) / 30 <> Int((intPntCount + 30) / 30)) Then
If (intPntCount < oSeries.Points.Count) Then
If (intPntCount <> IntLastDispDay - 1) Then
oPnt.DataLabel.Caption = vbNullString
Else
oPnt.DataLabel.Font.Size = 20
End If
End If
End If
End If
intPntCount = intPntCount + 1
Next
Debug.Print DateDiff("s", startDate, Now)
Next
Me.TimerInterval = 1
End With
Thanks all for your help
Maybe you need to avoid screen refresh with:
Application.ScreenUpdating = False
and then
Application.ScreenUpdating = true
when finished. It also be helpful if you use \ insted of / when dividing, if you don't care about working only with integers. Try it.
Maybe you should replace:
If ((intPntCount + 30) / 30 <> Int((intPntCount + 30) / 30)) Then
with something like
If (((intPntCount + 30) MOD 30) > 0 ) Then
and measure the time of execution. Another thing about your code is that:
oPnt.DataLabel.Font.Size = 14
...maybe should be inside the if's trying to avoid rewrite the property two times. Try something like:
If (((intPntCount + 30) MOD 30) > 0 ) Then
If (intPntCount < oSeries.Points.Count) Then
If (intPntCount <> IntLastDispDay - 1) Then
oPnt.DataLabel.Caption = vbNullString
oPnt.DataLabel.Font.Size = 14
Else
oPnt.DataLabel.Font.Size = 20
End If
Else
oPnt.DataLabel.Font.Size = 14
End If
Else
oPnt.DataLabel.Font.Size = 14
End If
Even it would be a very very little improvement to precalculate
(intPntCount + 30)
in a variable after
intPntCount = intPntCount + 1
...and use something like:
dim intPntCountSum= 0
(...)
End If
intPntCount = intPntCount + 1
intPntCountSum=intPntCount + 30
Next
Finally, if you don't need the debug info, it would be a good thing to delete the lines:
Debug.Print "Series" & intCptSeries
and
Debug.Print DateDiff("s", startDate, Now)
I hope it help.

Validating that a comma-separated list of values follows a specific sequence

I have a loop I created to check if the values entered match an ordering, depending on the augment passed. So for example the ordering constraint must be
"SU", "M", "TU", "W", "TH", "F", "SA"
therefore if the user enters the following inputs
"SU,M,TU,SA" this is correct
however if the user enters
"SU,TH,M" this is incorrect since M should come before TH
The coding has been implemented and works fine however i don't find this was the best way of coding it, can anyone help me code it more efficiently?
Function validExDays(exDays As String)
Dim found As Boolean
found = False
If Len(exDays) >= 1 And Not IsNull(exDays) Then
Dim NumOfCommas As Integer
NumOfCommas = InstrCount(exDays, ",")
Dim days(0 To 7) As String
days(0) = ","
days(1) = "SU"
days(2) = "M"
days(3) = "TU"
days(4) = "W"
days(5) = "TH"
days(6) = "F"
days(7) = "SA"
Dim i, j, k, l, m, o, p, q As Integer
i = 1
j = 1
k = 1
l = 1
m = 1
o = 1
p = 1
q = 1
Do While i <= 7
If NumOfCommas = 0 Then
'One day input check
If i = 1 Then
Do While j <= 7
If UCase(exDays) = days(j) Then
found = True
Exit Do
End If
j = j + 1
Loop
End If
End If
'Two day input check
j = 1
If NumOfCommas = 1 Then
If found = False And i = 2 Then
Do While j <= 7
Do While k <= 7
If UCase(exDays) = days(j) + days(0) + days(k) Then
found = True
Exit Do
End If
k = k + 1
Loop
If found = False Then
j = j + 1
k = j
Else
Exit Do
End If
Loop
End If
End If
'Three day input check
So the string value entered can be "SU,M,F" or "SU,F" or any other combination but whatever items are included must be in the correct order.
The following code is a bit more compact. It uses the Split() function to break out the components, and uses a Dictionary object to hold the index values of each valid component
Option Compare Database
Option Explicit
Public Function IsValidExDays(exDays As String) As Boolean
Dim rtn As Boolean
Dim valueArray() As String, valueItem As Variant
Dim maxValue As Integer
Dim dict As Object ' Scripting.Dictionary
rtn = True
Set dict = CreateObject("Scripting.Dictionary")
dict.Add "SU", 1
dict.Add "M", 2
dict.Add "TU", 3
dict.Add "W", 4
dict.Add "TH", 5
dict.Add "F", 6
dict.Add "SA", 7
maxValue = 0
valueArray = Split(exDays, ",")
For Each valueItem In valueArray
If dict.Exists(valueItem) Then
If dict(valueItem) > maxValue Then
maxValue = dict(valueItem)
Else
rtn = False
Exit For
End If
Else
rtn = False
Exit For
End If
Next
Set dict = Nothing
IsValidExDays = rtn
End Function
Since you are in Access, why don't you make an entry form with checkboxes that will always return the parameters in the order you expect?