Below is working VB, but I want to set variable D5:D222, F5:F222 and I5:I222 and to see result in G5:G222.
Below is for single row, but I need it to run for all selected rows. I tried all but I don't know how to set it.
Dim score As Integer, result As String
D5 = Range("D5").Value
F5 = Range("F5").Value
I5 = Range("I5").Value
If D5 = 1 And F5 = 1 Then
result = "=I5*0.67"
End If
If D5 = 1 And F5 = 0 Then
result = "=I5"
End If
If D5 = 0 Then
result = "0"
End If
Range("G5").Value = result
If solution with formulas is OK, you can enter in G5:
=D5*I5*(1-0.33*F5)
and fill it down to row 222
If you want VBA code to calculate the value, you can use:
Dim i as Integer
For i = 5 to 222
Range("G" & i).Value = _
(Range("I" & i).Value*(1-0.33)*Range("F" & i).Value)*Range("D" & i).Value
Next i
If you want VBA code to automatically fill the formula in each cell:
Range("G5:G222").FormulaR1C1 = "=RC[-3]*RC[2]*(1-0.33*RC[-1])"
Related
I am trying to conditionally color a bunch of cells on Tab1. I am using data from a column on Tab2 and also a column on Tab3, in an attempt to match to that given cell variables.
Basic logic is:
If there is a match to the cell in column B of Tab2, then check the value in column E of that same row on Tab2.
If that value in column E is greater than zero in Tab2, then colorize the initial cell value in the search range on Tab1 on color... but if I also exist on Tab3 too, then color something else.
Copy and paste of portions of the code. This is a blown out ‘non-working’ version of the code. It takes forever to run, if it does run.
For Each cellValue In mainRng2
‘if I do not exist in SerializedInvtLocations, but do exist in NonSerializedInventory then check the value in cell E is greater than zero.
If VBA.IsError(Application.match(cellValue, Sheets("SerializedInvtLocations").Range("A2:A" & lngLastRowSer), 0)) And Not VBA.IsError(Application.match(cellValue, Sheets("NonSerializedInventory").Range("B2:B" & lngLastRowNon), 0)) Then
For Each cell In Sheets("NonSerializedInventory").Range("B2:B" & lngLastRowNon)
x = x + 1
checker = Application.WorksheetFunction.VLookup(cellValue, Range("B" & x), 1, False)
'if the vlookup value in B2
If (checker = cellValue) Then
'i exist in non-serialized list, do I have a quant > 0?
quant = Application.WorksheetFunction.VLookup(cellValue, Range("E" & x), 1, False)
If quant >= 1 Then
cellValue.Interior.ColorIndex = 8 'teal
‘Sheets("Serialized and Non-Serialized").Range(cell.Address).Interior.Color = RGB(0, 255, 0)
‘ Debug.Print "Checker value is: " & checker & " and " & cell.Address & "/" & cell.Value
i3 = i3 + 1 ‘ counter
Else
cellValue.Interior.ColorIndex = 15 'gray
End If
End If
Next cell
End If
Next cellValue
Currently, the file just hangs and does not produce results (or it taking over 40 minutes to run and I just quit out). If I modify the code and change things up - I CAN get results, but they are not accurate.
EDIT:
Another attempt:
If inSer = cellValue.Value And inNon = cellValue.Value Then
If inNonQuan >= 1 Then
cellValue.Interior.ColorIndex = 46
Else
cellValue.Interior.ColorIndex = 4
End If
End If
If inSer <> cellValue.Value And inNon = cellValue.Value Then
If inNonQuan >= 1 Then
cellValue.Interior.ColorIndex = 8
Else
cellValue.Interior.ColorIndex = 15
End If
End If
If inSer = cellValue.Value And inNon <> cellValue.Value Then
cellValue.Interior.ColorIndex = 4
End If
If inSer <> cellValue.Value And inNon <> cellValue.Value Then
cellValue.Interior.ColorIndex = 15
End If
You should be able to do something with this:
Sub Tester()
Dim c As Range, mainRng2 As Range, t2q As Variant, t3m As Boolean, Tab2, Tab3, wb
Set wb = ActiveWorkbook 'or ThisWorkbook ?
Set Tab2 = wb.Worksheets("Tab2")
Set Tab3 = wb.Worksheets("Tab3")
Set mainRng2 = wb.Worksheets("Tab1").Range("A2:A1000") 'for example
For Each c In mainRng2
'quantity on Tab2 from colE, based on ColB match
' will be an error value if no match found
t2q = Application.VLookup(c.Value, Tab2.Range("B:E"), 4, False)
'any match on Tab3 ColA ?
t3m = Not IsError(Application.Match(c.Value, Tab3.Range("A:A"), 0))
'did we get a quantity from Tab2 (was there any match)?
If Not IsError(t2q) Then
If t2q >= 1 Then
'15 if also a match on tab3, else 8
c.Interior.ColorIndex = IIf(t3m, 15, 8)
End If
End If
Next c
End Sub
My solution was disappointingly simple - VLookup only returns the first instance of a matching value, and not all subsequent values. Instead of vlookup, I should have basically 'summed' the values of a column to get anything greater than zero.
So, I haven't figured out how to do this.
Basically, I want something like this:
P1 P2 P3 TOTAL SCORE
-- -- -- P1 P2 P3
21 / 13 1 2 0
/ 17 10
6 7 /
So, the three columns must compare to one-another (the "/" means that the player didn't play that game, but it doesn't have to be printed), the greatest among the three gets a +1 value in the TOTAL SCORE tab.
Plus, is there any easier way to do this than comparing one cell to another cell? I mean, is there a possibility to drag and mark all cells on all of the three columns and make sure that they only compare the cells in the three columns IN THE SAME ROW?
Let us assume that the data appears as in the picture in Sheet1 (Don't change the structure):
Open an Excel
Press ALT & F11 to open Visual Editor
Add a module from > Insert (in the Upper toolbar) - Module ( third option)
Paste the below codes & execute Sub Evaluation() (press F5 when your cursor is in Sub Evaluation)
To store lastrow in order to continue from the next record i use sheet2 range A1
Try:
Option Explicit
Public Sub Process_Data(ByVal I_Value As Long)
Dim LastRow As Long
Dim i As Long
Dim CA As Integer
Dim CB As Integer
Dim CC As Integer
With Sheet1
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = I_Value To LastRow '<= Lets say that the first score is at sheet1 column A row 3.LastRow represent the row of the last data in column A
CA = 0
CB = 0 '<= Every time that i change value we zero our variables to get the new value
CC = 0
If .Range("A" & i).Value = "/" Then '<= Check if there is a number or "/".if there is "/" we zero variable
CA = 0
Else
CA = .Range("A" & i).Value
End If
If .Range("B" & i).Value = "/" Then
CB = 0
Else
CB = .Range("B" & i).Value
End If
If .Range("C" & i).Value = "/" Then
CC = 0
Else
CC = .Range("C" & i).Value
End If
If CA > CB And CA > CC Then ' <= Check which number is bigger
.Range("E3").Value = .Range("E3").Value + 1 '<= At one point to each category
ElseIf CB > CA And CB > CC Then
.Range("F3").Value = .Range("F3").Value + 1
ElseIf CC > CA And CC > CB Then
.Range("G3").Value = .Range("G3").Value + 1
End If
Next i
End With
End Sub
Sub Evaluation()
Dim Value As Long
Dim LastRow As Long
LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
If (LastRow = 2) Or (LastRow = Sheet2.Range("A1").Value) Then '<= Check if the table has new data
Exit Sub
Else
If Sheet2.Range("A1").Value = "" Then '<=Check which value will adopt be i
Value = 3
Else
Value = Sheet2.Range("A1").Value + 1
End If
End If
Call Process_Data(I_Value:=Value)
Sheet2.Range("A1").Value = Sheet1.Range("A" & Rows.Count).End(xlUp).Row '<= Record the lastrow processed out
End Sub
Use the LARGE function to find the highest number for the individual games on the left. Then use an IF statement out to the right to check if the value of the LARGE function matches the player's game score. If it does match (TRUE), assign a value of 1. If it doesn't match (FALSE), assign a value of 0. Then SUM each player's modifiers that you've assigned with the IF function.
If ties are possible in the individual game scores, you'll also need to nest another IF function to handle that possibility.
I am trying to do a vba code for excel where I can retrieve the comparison operator(e.g. <, <= etc.) from the excel sheet. What I am trying to do give a score based on the value and the bands being key in.
I wanted to do something like this in the code:
Sample data:
cell A1 = 80(input)
cell A4 = "<"
cell B4 = 75
cell C4 = "="
cell D4 = 75
cell E4 = ">"
cell F4 = 75
Example of the code I wanted to do:
dim score as integer
dim result as integer
score = range("A1").value
methodoperatorb1 = range("A4").value
methodoperatorb2 = range("C4").value
methodoperatorb3 = range("E4").value
band1 = range("B4").value
band2 = range("D4").value
band3 = range("F4").value
if score (methodoperator1)(band1) then result = 1
elseif score (methodoperator2)(band2) then result = 2
else result = 3
Sorry for the bad example and really hope someone can help me with this problem.
You could use Evaluate to evaluate the expressions like this:
Sub foo()
Dim score As Integer
score = Range("A1").Value
methodoperatorb1 = Range("A4").Value
methodoperatorb2 = Range("C4").Value
methodoperatorb3 = Range("E4").Value
band1 = Range("B4").Value
band2 = Range("D4").Value
band3 = Range("F4").Value
Dim result As Integer
If Application.Evaluate(score & methodoperatorb1 & band1) Then
result = 1
ElseIf Application.Evaluate(score & methodoperatorb2 & band2) Then
result = 2
Else
result = 3
End If
MsgBox result
End Sub
Note that this will only work if the total length of the expression is under 256 characters.
I want to repeat my 'if then else' condition on the 30 rows that follow.
This is my code (I am new to this).
Dim score As Range, result As Double
If Range("A2") = "2a" Then
Range("C2") = 20
Else
If Range("A2") = "3c" Then
Range("C2") = 23
So at the moment when I enter 2a / 3c in cell A2, the number 20 / 23 comes up in cell C2.
I would like the same thing to happen in row 3, 4, 5 ... 30. When I enter 2a / 3c in cell A5, the number 20 / 23 comes up in cell C5.
Is it possible with a loop or another type of code? Or will I have to copy this over and over for each row?
Any help is really appreciated.
Thanks!
Here's a basic for-next loop that would accomplish what you ask...
For i = 2 To 30
If Range("A" & i) = "2a" Then
Range("C" & i) = 20
End If
If Range("A" & i) = "3c" Then
Range("C" & i) = 23
End If
Next
Here's a tutorial I picked at random from a Google search.
Try this as well
Dim score As Range, c As Range, x
Set score = Range("A2:A32").SpecialCells(xlCellTypeConstants, 23)
For Each c In score.Cells
x = IIf(c = "2a", 20, IIf(c = "3c", 23, ""))
c.Offset(0, 2) = x
Next c
Private Sub Worksheet_Change(ByVal Target As Range)
if not intersect(target,range("A2:A32")) is Nothing then target.offset(,2)=iif(instr("2a3a",target)>0,20+3*abs(target="3c"),"")
End sub
I am new to creating macros in Excel, and I am in a difficult position. I have a woorksheet of 48 columns and 6000+ rows. I have to retrieve select data from 20 columns and all rows, and place them into table of 3 columns and equal number of rows. For example Copy Sheet1: A2, E1, E3 and Paste into New Sheet3: A2, B2, C2. Needs to be automated due to size of spreadsheet, and the fact that the data is not formatted to be copied directly
I received an error 424 (Object Needed) using the following script.
Private Sub CommandButton1_Click()
Dim Counter As Integer
Counter = 3
Counter_H = 2
Do Until ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Cells(Counter, 4).Value = " "
thisworkbooks.Sheets("Sheet1").Select("A" & Counter, "B" & Counter, "C" & Counter).Value = thisworkbooks.Sheets("MASTER_LEAK_REPAIRS_CY2012").Select("D" & Counter, "Q" & (Counter - Counter_H), "Q" & Counter).Value
Counter = Counter + 1
Counter_H = Counter + 1
Loop
End Sub
Please help me.
New answer, based on below comment.
Private Sub CommandButton1_Click()
Dim Counter As Integer
Counter = 3
Counter_H = 2
Do Until ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Cells(Counter, 4).Value = ""
ThisWorkbook.Sheets("Sheet1").Range("A" & Counter) = ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Range("D" & Counter)
ThisWorkbook.Sheets("Sheet1").Range("B" & Counter) = ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Range("Q" & (Counter - Counter_H))
ThisWorkbook.Sheets("Sheet1").Range("C" & Counter) = ThisWorkbook.Sheets("MASTER_LEAK_REPAIRS_CY2012").Range("Q" & Counter)
Counter = Counter + 1
Counter_H = Counter + 1
Loop
End Sub
When I tried you original, I received error 450, but with this I did not.
Let me know if you have any problems!