Here's what I want to do and I realized it wasn't working.
If Time > 23 And Time < 7 Then
ws.Cells(Target.Row, 12).Value = 3
ElseIf Time > 7 And Time < 15 Then
ws.Cells(Target.Row, 12).Value = 1
Else
ws.Cells(Target.Row, 12).Value = 2
End If
What I want to do with this stuff... if the actual time is over 11 PM but less than 7 am... it writes 3 in a cell... and so on... The problem is that I realized that this comporison Time > 23 or Time < 7 doesn't work... how can I compare Time function with the actual hour?
Thanks!
Give this a try
If Hour(now) > 23 or Hour(now) <= 7 Then
ws.Cells(Target.Row, 12).Value = 3
ElseIf Hour(now) > 7 And Hour(now) < 15 Then
ws.Cells(Target.Row, 12).Value = 1
Else
ws.Cells(Target.Row, 12).Value = 2
End If
Something like this. I have used sample variables in place of Target and knowing which sheet ws was
Sub Timing()
Dim ws As Worksheet
Dim dbTime As Double
Set ws = Sheets(1)
dbTime = Time
If dbTime > 23 / 24 Or dbTime < 7 / 24 Then
ws.Cells(1, 12).Value = 3
ElseIf dbTime >= 7 / 24 And dbTime < 15 / 24 Then
ws.Cells(1, 12).Value = 1
Else
ws.Cells(1, 12).Value = 2
End If
End Sub
You need to extract the hour from the time, which you can do with the DatePart function e.g.
Dim CurrentHour
CurrentHour = DatePart("h", Time)
If CurrentHour > 23 Or CurrentHour < 7 Then
....
Related
Good afternoon,
I'm wondering if anyone knows of a better approach for finding the extended quantity of a row (based on level.) The dataset looks similar to this:
Level
Component
Quantity
ExtQty (formula)
Purchase
1
complete component 1
2
2
M
2
component 2
4
8
P
3
component 3
4
0
M
2
component 4
4
8
M
3
component5
10
80
M
1
complete component 2
1
1
M
2
component2
4
4
P
3
component3
4
0
M
2
component8
4
4
M
3
component9
10
40
M
I'm using:
=#IF(A2-1<1,C2,IF(XLOOKUP(A2-1,$A$2:$A2,$E$2:$E2,"ERR",0,-1)="P",0,XLOOKUP(A2-1,$A$2:$A2,$D$2:$D2,"ERR",0,-1)*$C2))
Currently it's still inserting over 184,000 rows and it's been about 50 minutes, still going...
(edit: finished at 53 minutes)
The goal is to take the quantity and multiply it with the quantity of the levels above. If the parent is a purchase part, set quantity to 0.
Does anyone have any tips to make this a little faster, other than working with a smaller dataset?
It seems to me that the table does not express the same behavior in each row, for example, I understand that in Level 3 = 10 * 2 * 2 * 2 = 80, but the Level 2 = 4 * 2. It does not have a fixed rule. In case you want to use the first it's "=POWER(2;A6)*C6" and otherwise "=POWER(2;A5-1)*C5"
I've decided to go with VBA. Currently running 184000 rows in 20 seconds rather than 53 minutes.
I'm not great at VBA, but this is what I came up with:
Sub ExtQty()
Dim cell As Range
Dim sheet As Worksheet
Dim levelStack, stopStack As Object
Dim lvlCol, extQtyCol, qtyCol, procCol, bomCol, itemCol, compCol As Integer
Dim Progress As Double
Dim i, j As Long
Set sheet = Application.ActiveSheet
ProgressForm.Show (vbModeless)
lRow = lastRow()
qtyCol = GetColumn("Quantity")
extQtyCol = qtyCol + 1
sheet.Columns(extQtyCol).Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
sheet.Cells(1, extQtyCol).Value = "ExtQty"
lvlCol = GetColumn("Level") 'after ExtQty insert for correct column
procCol = GetColumn("Procurement")
compCol = GetColumn("Component")
itemCol = GetColumn("Item")
Set levelStack = CreateObject("System.Collections.Stack")
sheet.Range(Cells(2, itemCol), Cells(lRow, itemCol)).Font.Bold = True
sheet.Range(Cells(2, compCol), Cells(lRow, compCol)).Font.Bold = True
sheet.Range(Cells(2, extQtyCol), Cells(lRow, extQtyCol)).Font.Bold = True
i = 1
For Each cell In sheet.Range(sheet.Cells(2, lvlCol), sheet.Cells(lRow, lvlCol))
Call ProgressForm.Progress(i, cell.Row, lRow, 1000) 'every 1000 loops; every loop hurts performance
If cell.Offset(1, 0).Value > cell.Value Then 'push parent level onto stack
If cell.Value = 1 Then
sheet.Cells(cell.Row(), extQtyCol).Value = sheet.Cells(cell.Row(), qtyCol).Value
Else
If levelStack.Peek()(1) = "F" Then
sheet.Cells(cell.Row(), extQtyCol).Value = 0
Else
sheet.Cells(cell.Row(), extQtyCol).Value = sheet.Cells(cell.Row(), qtyCol).Value * levelStack.Peek()(0)
End If
End If
levelStack.Push Array(sheet.Cells(cell.Row(), extQtyCol).Value, sheet.Cells(cell.Row(), procCol).Value)
ElseIf cell.Offset(1, 0).Value < cell.Value Then 'check if leaving current level and pop
If cell.Value = 1 Then
sheet.Cells(cell.Row(), extQtyCol).Value = sheet.Cells(cell.Row(), qtyCol).Value
If cell.Row >= lRow Or cell.Offset(1, 0).Value = "" Then 'fixed error if last row AND level 1
Exit For
End If
ElseIf levelStack.Peek()(1) = "F" Then
sheet.Cells(cell.Row(), extQtyCol).Value = 0
Else
sheet.Cells(cell.Row(), extQtyCol).Value = levelStack.Peek()(0) * sheet.Cells(cell.Row(), qtyCol).Value
End If
If cell.Value > cell.Offset(1, 0).Value Then
diff = cell.Value - cell.Offset(1, 0).Value
End If
For j = 1 To diff 'used for when level drops more than one level
If cell.Row() = lRow Then
topStack = levelStack.Clear()
Exit For
Else
topStack = levelStack.Pop()
End If
Next
Else 'All others - don't push or pop
If cell.Value = 1 Then
sheet.Cells(cell.Row(), extQtyCol).Value = sheet.Cells(cell.Row(), qtyCol).Value
ElseIf levelStack.Peek()(1) = "F" Then
sheet.Cells(cell.Row(), extQtyCol).Value = 0
Else
sheet.Cells(cell.Row(), extQtyCol).Value = levelStack.Peek()(0) * sheet.Cells(cell.Row(), qtyCol).Value
End If
End If
sheet.Cells(cell.Row(), extQtyCol) = Round(sheet.Cells(cell.Row(), extQtyCol), 3)
Next
ProgressForm.Hide
End Sub
I'm looking into a do while loop to enter a number on cellcert, 4, and return a value on cellcert,5. However, if the cellcert, 4 value is more than 1, it will add 5 for every "1's" so it has the If logic below:
1 = 18, 2 = 18+5, 3 = 18+5+5, 4 = 18+5+5+5 and so on...
This is why I'm looking into incorporating separate function(s) to do the adding of 5 code and call it within Sub TATcomputation()
Sub TATcomputation()
Dim certcell As Integer
certcell = 2
Do While Cells(certcell, 4).Value <> ""
Cells(certcell, 5).Value = Cells(certcell, 4).Value * 18
certcell = certcell + 1
Loop
End Sub
You dont need a IF statement here. Just always start with 18 and then multiply your cell value in Column D (less one) by 5
'Do While....
Cells(certvalue, 5).Value = 18 + ((Cells(certvalue, 4) -1) *5)
'certvalue = cervalue + 1
'Loop
You should qualify those Cells objects or use a With block btw
How about:
Sub TATcomputation()
Dim certcell As Integer
certcell = 2
Do While Cells(certcell, 4).Value <> ""
If certcell = 2 Then
Cells(certcell, 5).Value = Cells(certcell, 4).Value * 18
Else
Cells(certcell, 5).Value = Cells(certcell, 4).Value * (18 + (5 * (certcell - 2)))
End If
certcell = certcell + 1
Loop
End Sub
Here is my "IN" List -
PN Qty Price
A 100 5
B 150 6
C 150 7
D 50 -9
E 100 5
F 5 9
G 20 6
I 5 7
J 15 7
J 30 10
K 100 10
K 50 10
A 20 8
Here is my "OUT" List -
PN Qty
A 120
B 10
C 110
D 60
E 100
J 20
J 10
Expected Results -
Manual Formula to calculate Price for PN = "A" = ((100*5)+(20*8))/120
PN Qty Price Total
A 120 5.5 660
B 10 6 60
C 110 7 770
D 60 -9 -540
E 100 5 500
J 20 7.75 155
J 10 10 100
I want to implement FIFO logic to calculate the Total Price in "OUT" List based on "Quantity" in "IN" List.
When you have tables like this, the outgoing button with following code:
Private Sub Outgoing_Click()
Dim pn As String
Dim ammout As Long
Dim current As Long
pn = InputBox("Which Item do you want to take out?")
ammount = InputBox("How Item do you want to take out?")
Dim cells As Long
Dim fifo As Double
counter = 1 //line where your table starts
current = 0
fifo = 0
Do Until IsEmpty(cells(counter, 13).Value Or current = ammount)
If cells(counter, 13).Value = pn Then
If cells(counter, 14).Value > (ammount - current) Then
fifo = fifo + (ammount - current) * cells(current, 15).value
current = ammount
Else
fifo = fifo + cells(counter, 14).Value * cells(counter, 15).Value
current = current + cells(counter, 14)
cells(counter, 14).Value = 0
End If
counter = counter + 1
Loop
fifo = fifo / ammount
End Sub
Should be work.
I did not match lie if you have enough in your current list and others so the validation part is missing.
your "Expected Results" doesn't match your "Manual Formula"
following this latter
Option Explicit
Sub main()
Dim cell As Range
Dim dictSum As Object
Dim dictRept As Object
Set dictSum = CreateObject("Scripting.Dictionary")
Set dictRept = CreateObject("Scripting.Dictionary")
With Worksheets("IN")
For Each cell In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
dictSum(cell.Value) = dictSum(cell.Value) + cell.Offset(, 1).Value * cell.Offset(, 2).Value
dictRept(cell.Value) = dictRept(cell.Value) + cell.Offset(, 1).Value
Next
End With
With Worksheets("OUT")
For Each cell In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
cell.Offset(, 2) = dictSum(cell.Value) / dictRept(cell.Value)
cell.Offset(, 3) = cell.Offset(, 1) * cell.Offset(, 2)
Next
End With
End Sub
I want to set the following condition but i can only get 2 condition to be done
The three condition are less than 7 days multiple by one value, the range between 2 dates multiply by one value and more than 30 days multiply by another value.
Not able to get all to work
Not sure what went wrong
' To create the following condition
'If less than 7 days interest = 0%
' if 8 to 30 days interest = 7%
'if more than 31 days interest = 9%
Sub Workbook_Open()
For i = 1 To 3 'Rows.Count
xdate = Cells(i, 1)
nulldate = DateAdd("d", -7, Date)
irate7late = DateAdd("d", -8, Date)
irate7early = DateAdd("d", -30, Date)
If Day(nulldate) < Day(xdate) Then
result = Cells(i, 2) * 1
ElseIf Day(irate7early) <= Day(xdate) And Day(xdate) <= Day(irate7late) Then
'30/9/2015 20/10/2015 20/10/2015 22/10/2015
result = Cells(i, 2) * 1.07
ElseIf Day(irate7early) > Day(xdate) Then
result = Cells(i, 2) * 1.09
End If
Cells(i, 3).Value = result
Next i
End Sub
Reversing your test may simplify them sometimes:
Sub Workbook_Open()
Dim delta as Long
Dim xdate as Date
For i = 1 To 3 'Rows.Count
xdate = Cells(i, 1).Value
delta = DateDiff("d", xdate, Date)
If delta > 30 Then
Cells(i,3).Value = Cells(i,2).Value * 1.09
ElseIf delta > 7 Then
Cells(i,3).Value = Cells(i,2).Value * 1.07
Else 'delta <= 7
Cells(i,3).Value = Cells(i,2).Value
End If
Next i
End Sub
And don't forget Option Explicit, it may save you a lot of time in debugging.
Try this below code for your requirement
Sub Workbook_Open()
Dim diffdate As Variant
For i = 1 To 3 'Rows.Count
xdate = Cells(i, 1).Value
diffdate = (DateDiff("d", xdate, Now()))
If diffdate < 7 Then
result = Cells(i, 2) * 1
ElseIf diffdate < 31 And diffdate > 7 Then
result = Cells(i, 2) * 1.07
Else
result = Cells(i, 2) * 1.09
End If
Cells(i, 3).Value = result
Next
End Sub
I have an Excel-Sheet with values in column D.
I would like to set the row height in relation to the value of cell D of each row.
Values in D are small %-values like 0.0593 %, except of the first (D4 = 31 %) and last (D92 = 40 %)
To get the small values at a reasonable height I'd like to multiply them with 10'000 - but there comes the problem with the 409 max height.
I have a script that works until it comes to the high values so I tried a if formula. But to be frankly: I have no Idea what I am doing here... I copied it together.
So the problems: working only in the range of D5-D91 and if a value should go over 409 give him something like 15px.
Thanx for your Help!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row - 1
With Cells(i, 4)
If .Cells(i, 4).Value * 10000 > 409 Then
Rows(i).RowHeight = 12
Else
Rows(i).RowHeight = Cells(i, 4).Value * 10000
End If
End With
Next i
End Sub
Copy the below code to any standard module & Run. You may have to tweak the code as per your requirement.
Sub sample()
Dim i As Long
For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 4).Value * 10000 > 409 Then
Rows(i).RowHeight = 12
Else
Rows(i).RowHeight = Cells(i, 4).Value * 10000
End If
Next
End Sub
Sub sample()
Dim i As Long
For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 4).Value * 100000 > 409 Then
Rows(i).RowHeight = 20
ElseIf Cells(i, 4).Value * 100000 < 10 Then
Rows(i).RowHeight = 12
Else
Rows(i).RowHeight = Cells(i, 4).Value * 100000
End If
Next
End Sub