I have slight problem with my code. I have code that extracts data from a DB and puts it into a table. Example:
I want the cells in L column to be highlighted (red for example) if the data is repeating itself for 3 shifts. Or if that can't be done, at least some way I could easily see when data is being repeated.
The idea is that I extract data that is out of a specific range.
SQL Code:
sql = "SELECT ID, (SELECT Number FROM WindingStands WHERE ID = TexMeasurements.WindingStandID) as Place, SpindleNumber, " _
& "(SELECT Number FROM Assortments WHERE ID = TexMeasurements.AssortmentID) as Sifrs, " _
& "(SELECT Name FROM Assortments WHERE ID = TexMeasurements.AssortmentID) as Sort, CreationTime, TexPV, TexSP " _
& " FROM TexMeasurements " _
& " WHERE CreationTime > " & fromdate & " AND CreationTime <= " & ToDate & " " _
& " AND (TexLimit <= -3 OR TexLimit >= 3) ORDER BY Place, SpindleNumber, CreationTime"
I use code to view the data for each day like so:
Sub LastShift()
If (Sheets(1).Cells(1, 1).Value - Sheets(1).Cells(1, 2).Value) > 0.75 Then
Sheets(1).Cells(2, 6).Value = Sheets(1).Cells(1, 2).Value + 0.75
Sheets(1).Cells(2, 3).Value = Sheets(1).Cells(2, 6).Value - 0.5
End If
If (Sheets(1).Cells(1, 1).Value - Sheets(1).Cells(1, 2).Value) < 0.25 Then
Sheets(1).Cells(2, 6).Value = Sheets(1).Cells(1, 2).Value - 0.25
Sheets(1).Cells(2, 3).Value = Sheets(1).Cells(2, 6).Value - 0.5
End If
If (Sheets(1).Cells(1, 1).Value - Sheets(1).Cells(1, 2).Value) > 0.25 And (Sheets(1).Cells(1, 1).Value - Sheets(1).Cells(1, 2).Value) < 0.75 Then
Sheets(1).Cells(2, 6).Value = Sheets(1).Cells(1, 2).Value + 0.25
Sheets(1).Cells(2, 3).Value = Sheets(1).Cells(2, 6).Value - 0.5
End If
Call ExtractData
Sub ThisShift()
If (Sheets(1).Cells(1, 1).Value - Sheets(1).Cells(1, 2).Value) > 0.25 And (Sheets(1).Cells(1, 1).Value - Sheets(1).Cells(1, 2).Value) < 0.75 Then
Sheets(1).Cells(2, 6).Value = Sheets(1).Cells(1, 2).Value + 0.75
Sheets(1).Cells(2, 3).Value = Sheets(1).Cells(1, 2).Value + 0.25
End If
If (Sheets(1).Cells(1, 1).Value - Sheets(1).Cells(1, 2).Value) < 0.25 Then
Sheets(1).Cells(2, 6).Value = Sheets(1).Cells(1, 2).Value + 0.25
Sheets(1).Cells(2, 3).Value = Sheets(1).Cells(2, 6).Value - 0.5
End If
If (Sheets(1).Cells(1, 1).Value - Sheets(1).Cells(1, 2).Value) > 0.75 Then
Sheets(1).Cells(2, 6).Value = Sheets(1).Cells(1, 2).Value + 1.25
Sheets(1).Cells(2, 3).Value = Sheets(1).Cells(2, 6).Value - 0.5
End If
Call ExtractData
In column K, you can put a formula, like this one:
=IF(AND(MATCH(J4;J3;0);MATCH(J4;J2;0));1;0)
In case cell values J3 and J4 are equal and J2 and J4 are equal, you see 1, otherwise you see #N/A (instead of zero, sorry). You can obviously also work with the the Exact() worksheet function.
Related
I have the below loop written, however I am having issues with the code entering the else if loop and to have the loop until (end if) the ranges equal each other. Essentially I want the loop to add 2 to the cells that contain "Corporates" first and afterwards add 1 to the cells that have a the number 2.
Dim x As Long
Dim V As Variant
V = Cells(Rows.Count, 1).End(xlUp).Row
JV = Range("J" & Rows.Count).End(xlUp).Row
For x = 1 To V
If Cells(x, 2).Value = "Corporates" Then
Cells(x, 7).Value = Cells(x, 7).Value + 1
ElseIf Cells(x, 12).Value < "3%" And Cells(x, 2).Value = "Corporates" Then
Cells(x, 7).Value = Cells(x, 7).Value + 1
End If
Range("J" & JV + 3).Value = Range("J" & JV + 2).Value
Next x
End Sub
Use a nested If instead of ElseIf
I'm guessing that < "3%" should be < 0.03 ("3%" is text, not a number).
If Cells(x, 2).Value = "Corporates" Then
If Cells(x, 12).Value < 0.03 Then
Cells(x, 7).Value = Cells(x, 7).Value + 2
Else
Cells(x, 7).Value = Cells(x, 7).Value + 1
End If
End If
Pic 2 shows what the solution should be and Pic 1 shows what my code has given me, the differences occur in the "Yearly Change","Percent Change" and "Total Stock Volume" columns.
The loop I created works for all the sheets but my figures in those specified column are off, can I get help in rectifying my code attached to get numbers similar to Pic 2? Thank you
Option Explicit
Sub Stockmarket()
'Declare and set worksheet
Dim ws As Worksheet
'Loop through all stocks for one year
For Each ws In Worksheets
'Create the column headings
ws.Range("I1").Value = "Ticker"
ws.Range("J1").Value = "Yearly Change"
ws.Range("K1").Value = "Percent Change"
ws.Range("L1").Value = "Total Stock Volume"
ws.Range("P1").Value = "Ticker"
ws.Range("Q1").Value = "Value"
ws.Range("O2").Value = "Greatest % Increase"
ws.Range("O3").Value = "Greatest % Decrease"
ws.Range("O4").Value = "Greatest Total Volume"
'Define Ticker variable
Dim Ticker As String
'Set initial and last row for worksheet
Dim Lastrow As Long
Dim i As Long
Dim j As Integer
Dim x As Double
j = 2
x = 2
'Define Lastrow of worksheet
Lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
'Set new variables for prices and percent changes
Dim open_price As Double
'open_price = 0
Dim close_price As Double
'close_price = 0
Dim price_change As Double
'price_change = 0
Dim price_change_percent As Double
'price_change_percent = 0
'Create variable to keep the ticker row in
Dim TickerRow As Long
TickerRow = 1
Dim stock_volume As Double
stock_volume = 0
'Do loop of current worksheet to Lastrow
For i = 2 To Lastrow
'Ticker symbol output
If ws.Cells(i + 1, 1).Value <> ws.Cells(i, 1).Value Then
TickerRow = TickerRow + 1
Ticker = ws.Cells(i, 1).Value
ws.Cells(TickerRow, "I").Value = Ticker
'Stock Volume output
If ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ElseIf ws.Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ws.Cells(j, 9).Value = ws.Cells(i, 1).Value
ws.Cells(j, 12).Value = stock_volume
j = j + 1
stock_volume = 0
End If
'Creating the Yearly change and Percent change output
open_price = ws.Cells(i, 3).Value
close_price = ws.Cells(i, 6).Value
ws.Cells(x, 10).Value = open_price - close_price
If close_price <= 0 Then
ws.Cells(x, 11).Value = 0
Else
ws.Cells(x, 11).Value = (close_price / open_price) - 1
End If
ws.Cells(x, 11).Style = "Percent"
If ws.Cells(x, 10).Value >= 0 Then
ws.Cells(x, 10).Interior.ColorIndex = 4
Else
ws.Cells(x, 10).Interior.ColorIndex = 3
End If
x = x + 1
ws.Cells(x, 9).Value = ws.Cells(i, 1).Value
ws.Cells(x, 10).Value = close_price - open_price
If close_price <= 0 Then
ws.Cells(x, 11).Value = 0
Else
ws.Cells(x, 11).Value = (close_price / open_price) - 1
End If
ws.Cells(x, 11).Style = "Percent"
If ws.Cells(x, 10).Value >= 0 Then
ws.Cells(x, 10).Interior.ColorIndex = 4
Else
ws.Cells(x, 10).Interior.ColorIndex = 3
End If
End If
Next i
Next ws
End Sub
You seem to have a logic problem - see the two marked lines below
'Ticker symbol output
If ws.Cells(i + 1, 1).Value <> ws.Cells(i, 1).Value Then '<<<<<<<<<
TickerRow = TickerRow + 1
Ticker = ws.Cells(i, 1).Value
ws.Cells(TickerRow, "I").Value = Ticker
'Stock Volume output
If ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value Then '<<< never true!
stock_volume = stock_volume + ws.Cells(i, 7).Value
ElseIf ws.Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ws.Cells(j, 9).Value = ws.Cells(i, 1).Value
ws.Cells(j, 12).Value = stock_volume
j = j + 1
stock_volume = 0
End If
i'm trying to solve a problem of mine and i'm pretty much a newbie in VBA.
I'm trying to make a quotation out of excel utilizing user form.
Transferring data is doable from the user form, but am having some difficulty to complete the quotation:
1. Creating new empty row base on input in user form
2. assign input to different rows and deleting any empty rows if there are no input.
This is my userform:
Private Sub okaybutton_Click()
'Make quotation activate
Sheet11.Activate
'Trasnfer Information sheet
Cells(2, 6).Value = DateBox.Value
Cells(6, 2).Value = "Company: " + CompanyBox.Value
Cells(8, 2).Value = "State: " + StateBox.Value
Cells(9, 2).Value = "Name: " + PICBox.Value
Cells(10, 2).Value = "Contact Number: " + ContactCustomer.Value
Cells(7, 2).Value = "Address: " + AddressBox.Value
Cells(7, 6).Value = SEBox.Value
Cells(8, 6).Value = CNBox.Value
Cells(11, 2).Value = CusEmail.Value
Cells(9, 6).Value = ACemail.Value
If PTWrequire.Value = True Then
Cells(13, 2).Value = "PTW application or safety induction required at site"
End If
If ESDrequire.Value = True Then
Cells(13, 2).Value = Cells(13, 2).Value & " " & " & ESD Attire required."
End If
'SupplySide information sheet
'Determine emptyRow
nextrow = WorksheetFunction.CountA(Range("B:B"))
nextrow1 = WorksheetFunction.CountA(Range("B:B")) + 1
nextrow2 = WorksheetFunction.CountA(Range("B:B")) + 2
'Dim nextrow As Long
'nextrow = Cells(Rows.Count, "A").End(xlUp).Row + 1
'flow measurement point 1
If FlowMeasure1.Value = True Then
Cells(nextrow, 3).Value = "Flow measurement, Measures dry air flow capacity."
If Hottap1.Value = "Yes" Then
Cells(nextrow, 3).Value = Cells(nextrow, 3).Value & "- perform hot tapping on " & "Main header size: " & Pipesize1.Value & """."
Else
Cells(nextrow, 3).Value = Cells(nextrow, 3).Value & " Main header size: " & Pipesize1.Value & """."
End If
If Pipesize1.Value = 2 Then
Cells(nextrow, 4).Value = "3700"
ElseIf Pipesize1.Value = 2.5 Then
Cells(nextrow, 4).Value = "3706"
ElseIf Pipesize1.Value = 3 Then
Cells(nextrow, 4).Value = "3945"
ElseIf Pipesize1.Value = 4 Then
Cells(nextrow, 4).Value = "3971"
ElseIf Pipesize1.Value = 5 Then
Cells(nextrow, 4).Value = "3971"
ElseIf Pipesize1.Value = 6 Then
Cells(nextrow, 4).Value = "4080"
End If
If SSquantity1.Value > 0 Then
Cells(nextrow, 2).Value = SSquantity1.Value
End If
'flow measurement point 2
If Hottap2.Value = "Yes" Then
Cells(nextrow1, 3).Value = "Flow measurement, Measures dry air flow capacity." & "- perform hot tapping on " & "Main header size: " & Pipesize2.Value & """."
ElseIf Hottap2.Value = "No" Then
Cells(nextrow1, 3).Value = Cells(nextrow1, 3).Value & " Main header size: " & Pipesize2.Value & """."
End If
If Pipesize2.Value = 2 Then
Cells(nextrow1, 4).Value = "3700"
ElseIf Pipesize2.Value = 2.5 Then
Cells(nextrow1, 4).Value = "3706"
ElseIf Pipesize2.Value = 3 Then
Cells(nextrow1, 4).Value = "3945"
ElseIf Pipesize2.Value = 4 Then
Cells(nextrow1, 4).Value = "3971"
ElseIf Pipesize2.Value = 5 Then
Cells(nextrow1, 4).Value = "3971"
ElseIf Pipesize2.Value = 6 Then
Cells(nextrow1, 4).Value = "4080"
End If
If SSquantity2.Value > 0 Then
Cells(nextrow1, 2).Value = SSquantity2.Value
End If
'flow measurement point 3
If Hottap3.Value = "Yes" Then
Cells(nextrow2, 3).Value = "Flow measurement, Measures dry air flow capacity." & "- perform hot tapping on " & "Main header size: " & Pipesize3.Value & """."
ElseIf Hottap3.Value = "No" Then
Cells(nextrow2, 3).Value = Cells(nextrow2, 3).Value & " Main header size: " & Pipesize3.Value & """."
End If
If Pipesize3.Value = 2 Then
Cells(nextrow2, 4).Value = "3700"
ElseIf Pipesize3.Value = 2.5 Then
Cells(nextrow2, 4).Value = "3706"
ElseIf Pipesize3.Value = 3 Then
Cells(nextrow2, 4).Value = "3945"
ElseIf Pipesize3.Value = 4 Then
Cells(nextrow2, 4).Value = "3971"
ElseIf Pipesize3.Value = 5 Then
Cells(nextrow2, 4).Value = "3971"
ElseIf Pipesize3.Value = 6 Then
Cells(nextrow2, 4).Value = "4080"
End If
If SSquantity3.Value > 0 Then
Cells(nextrow2, 2).Value = SSquantity3.Value
End If
End If
On Error Resume Next
Worksheet.Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub
I have the following code
Dim i As Integer
For i = 3 To 10
If Range("H3").Value = Cells(i, 2).Value And Range("I3").Value < Cells(i, 4).Value And _
Range("I3").Value >= Cells(i, 3).Value Then
Range("J3").Value = Cells(i, 5).Value
End If
Next i
I want the value of J3 to represent the sum of all the iterations and not just the last iteration if i. Can it be done?
While there are certainly better methods of adding up cells, for your particular method this should work.
Dim i As long, lTotal as long
For i = 3 To 10
If Range("H3").Value = Cells(i, 2).Value And Range("I3").Value < Cells(i, 4).Value And _
Range("I3").Value >= Cells(i, 3).Value Then
lTotal = Cells(i, 5).Value + lTotal
End If
Next i
Range("J3").Value = lTotal
Keep a running total of of your loop, then use the running total as your cell's value after you've finished the loop
Change this line
Range("J3").Value = Cells(i, 5).Value
To:
Range("J3").Value = Range("J3").Value + Cells(i, 5).Value
I am trying to match to sheets with same records and update one sheet based on another. The updated goes with and incremental of '1' in respective cell.
It was able to write it so the cells with values will be updated respectively.
The problem is that I can't figure it out how to increment a cell that contains a string. (some cells contain ">1", ">2" and so on) I am trying to increment those if needed to change to ">2" and ">3" and so on.
The moment I should paste the code is bolded.
Sub Increment()
For Each SnowCell In MySnowRange
For Each TrakerCell In MyTrakerRange
If TrakerCell.Value = SnowCell.Value Then
If TrakerCell.Offset(, 1).Value <> SnowCell.Offset(, 1).Value Then
TrakerCell.Offset(, 1).Value = SnowCell.Offset(, 1).Value
Select Case SnowCell.Offset(, 1).Value
Case "In Queue"
If Application.WorksheetFunction.IsNumber(TrakerCell.Offset(, 3).Value + 1) = True Then
TrakerCell.Offset(, 3).Value = TrakerCell.Offset(, 3).Value + 1
Else
**TrakerCell.Offset(, 3).Value = Split(TrakerCell.Offset(, 3).Value)**
Case "Assigned"
TrakerCell.Offset(, 4).Value = TrakerCell.Offset(, 4).Value + 1
Case "Work In Progress"
TrakerCell.Offset(, 5).Value = TrakerCell.Offset(, 5).Value + 1
Case "Pending"
TrakerCell.Offset(, 6).Value = TrakerCell.Offset(, 6).Value + 1
Case "Resolved"
TrakerCell.Offset(, 7).Value = "Resolved"
End Select
ElseIf TrakerCell.Offset(, 1).Value = SnowCell.Offset(, 1).Value Then
Select Case SnowCell.Offset(, 1).Value
Case "In Queue"
TrakerCell.Offset(, 3).Value = TrakerCell.Offset(, 3).Value + 1
Case "Assigned"
TrakerCell.Offset(, 4).Value = TrakerCell.Offset(, 4).Value + 1
Case "Work In Progress"
TrakerCell.Offset(, 5).Value = TrakerCell.Offset(, 5).Value + 1
Case "Pending"
TrakerCell.Offset(, 6).Value = TrakerCell.Offset(, 6).Value + 1
Case "Resolved"
TrakerCell.Offset(, 7).Value = "Resolved"
End Select
End If
Else
End If
Next
Next
End Sub
From what I can see, your comparison is working, it's your update that you need to resolve. Write a function that will return you an updated value. What you will need the function to do is first extract the numeric value from the string (have a look at these 2 post on how to do that: Post1 and Post2). Now that you have your numeric value, increment it as per your requirements. Next, replace the numeric value with your new updated value (this should be too hard to do: you have your old value and the new value, just use Replace to change it in the string). You can now use this function to assign the value to your Offset cells
Thanks!
Have done it this way and it works:
Case "In Queue"
If Application.WorksheetFunction.IsNonText(TrakerCell.Offset(, 3).Value) = True Then
TrakerCell.Offset(, 3).Value = TrakerCell.Offset(, 3).Value + 1
Else
a = Left(TrakerCell.Offset(, 3).Value, 1)
b = Right(TrakerCell.Offset(, 3).Value, Len(TrakerCell.Offset(, 3).Value) - 1)
c = b + 1
d = a & c
TrakerCell.Offset(, 3).Value = d
End If
:)!
If you know that there is always only one character before the number, then just:
Set c = TrakerCell(, 4) ' same as TrakerCell.Offset(, 3).Resize(1, 1)
c.Value = Left(c, 1) & (Mid(c, 2) + 1)
but if the number of non-numeric characters varies, then it can be changed a bit to:
Set c = TrakerCell(, 4)
L = Len(c) - Len(Str(Val(StrReverse(c)))) + 1 ' number of characters before the number + 1
c.Value = Left(c, L) & (Mid(c, L + 1) + 1)