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
Related
I'm trying to write a code which changes the color of cells in the specified area based on previously defined values (dates). So if the defined date minus actual date is smaller than zero then cells interior color changes to red.
I'm pulling data from area: From row 2 To 160 And column 24 to 33. I'm checking the difference between these dates and the actual date and if its less than zero I want cells in the region: Row 2 To 160 and column 10 to 19 to change color to red.
I wrote a simple code to only test if it works. But the color is changed to red skipping the condition (some values are grater then zero and either way they are red).
Sub niowy()
Worksheets("External").Activate
For i = 2 To 160
For j = 24 To 33
For k = 10 To 19
If Cells(i, j).Value = "" Then
Cells(i, j).Select
Cells(i, k).Select
ElseIf Cells(i, j).Value - Date > 0 And Cells(i, j).Value - Date < 20 Then
Cells(i, k).Interior.Color = rgbOrange
ElseIf Cells(i, j).Value - Date < 0 Then
Cells(i, k).Interior.Color = rgbRed
End If
Next k
Next j
Next i
End Sub
If you have any idea to speed up a code a little bit or a different approach I would be grateful for any ideas. Take into consideration I'm just starting learning vba so the code might be pretty messy. I also tested "datediff" function but it failed.
Sub niowy()
Dim target As Range
Dim i As Long
Dim j As Long
With Worksheets("Main")
For i = 2 To 160
For j = 24 To 33
If Val(.Cells(i, j)) = 0 Then
Else
Set target = .Range("J" & i & ":t" & i)
Select Case (.Cells(i, j).Value - Date)
Case 1 To 20
target.Interior.Color = rgbOrange
Case Is < 0
target.Interior.Color = rgbRed
End Select
End If
Next j
Next i
End With
End Sub
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.
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])"
lets say in column A:Row 2, I have a score of 45 and in column B, I have the amount of people that got that score. what i then want to do is on column D, output that score X amount of times. x=repitition.
in the exmaple 5 people got a score of 45 so in column D i want to insert 5 scores of 45. then I see in column A:Row2 3 people got a score of 46 then after the last 45, in column D I want to append 46 3 times.. and so on..
Could someone show me how to do this?
Here you go:
Sub test_scores_repitition()
'run with test scores sheet active
r = 1
dest_r = 1
Do While Not IsEmpty(Range("a" & r))
If IsEmpty(Range("b" & r)) Then Range("b" & r).Value = 0 'if there's no quantity listed for a score, it assumes zero
For i = 1 To Range("b" & r).Value
Range("d" & dest_r).Value = Range("a" & r).Value
dest_r = dest_r + 1
Next i
r = r + 1
Loop
End Sub
Macro answer:
Sub WriteIt()
Dim lrow As Long
Dim WriteRow As Long
Dim EachCount As Long
Dim ReadRow As Long
' find last in list of numbers
lrow = Range("A1").End(xlDown).Row
'start at 2 because of headers
WriteRow = 2
ReadRow = 2
While ReadRow <= lrow
For EachCount = 1 To Cells(ReadRow, 2)
'repeat the number of times in column B
Cells(WriteRow, 4) = Cells(ReadRow, 1)
'the number in column A
WriteRow = WriteRow + 1
Next
ReadRow = ReadRow + 1
'and move to the next row
Wend
'finish when we've written them all
End Sub
it is possible with a formula, just not really recommended as it looks auful, and would be difficult to explain. It uses a Microsoft formula to count the number of unique items in the data above, and once it counts the number it is supposed to write of the number above, it moves to the next number. The formula does not know where to stop, and will put 0 when it runs out of data.
in D2, put =A2
In D3, and copied down, put
=IF(COUNTIF($D$2:D2,OFFSET($A$1,SUM(IF(FREQUENCY($D$2:D2,$D$2:D2)>0,1)),0))<OFFSET($B$1,SUM(IF(FREQUENCY($D$2:D2,$D$2:D2)>0,1)),0),OFFSET($A$1,SUM(IF(FREQUENCY($D$2:D2,$D$2:D2)>0,1)),0),OFFSET($A$1,SUM(IF(FREQUENCY($D$2:D2,$D$2:D2)>0,1))+1,0))
I need to Loop the formula below until Column "B" which contains dates is empty.
I am stuck and I just can't seem to write the VBA Code to do the Loop until there is no more Dates in Column "B". The formula is smoothing out the yields by using those dates that have a yield.
I hope anyone would be able to help me. Thanks in advance
A B C D
5 Factor Date Yield Input
6 3 May-10 .25
7 1 Jun-10
8 2 Jul-10
9 3 Aug-10 0.2000
10 1 Sep-10
11 2 Oct-10
12 3 Nov-10 0.2418
13 1 Dec-10
14 2 Jan-11
15 3 Feb-11 0.3156
16 1 Mar-11
17 2 Apr-11
Sub IsNumeric()
' IF(ISNUMBER(C6),C6,
If Application.IsNumber(range("c6").Value) Then
range("d6").Value = range("c6")
' IF(C6<C5,((OFFSET(C6,2,0)-OFFSET(C6,-1,0))*A6/3+OFFSET(C6,-1,0)),
If range("c6").Select < range("c5").Select Then
range("d6").Value = range("c6").Offset(2, 0).Select - range("c6").Offset(-1, 0).Select * (range("a6").Select / 3) + range("c6").Offset(-1, 0).Select
' IF(C6<>C7,((OFFSET(C6,1,0)-OFFSET(C6,-2,0))*(A6/3)+OFFSET(C6,-2,0)),"")))
If range("c6").Select <> range("c7").Select Then
range("d6").Value = (range("c6").Offset(1, 0).Select) - range("c6").Offset(-2, 0).Select * (range("a6").Select / 3) + range("c6").Offset(-2, 0).Select
Else
range("d6").Value = ""
End If
End If
End If
End Sub
Sub Test01()
Dim m, r, cell As Object
Dim n As Boolean
Set m = Sheets("Sheet1").Cells(1, 2)
Do
Set m = m.Offset(1, 0)
Set r = m.Resize(20, 1)
n = False
For Each cell In r
If cell.Formula <> "" Then
n = True
End If
Next cell
MsgBox m.Formula
Loop Until n = False
End Sub
This will start at B1 and loop all the way down Column B until the loop encounters a cell at which, beneath it, are 20 contiguous blank cells. When the loop arrives at that cell that has 20 consecutive blanks cells beneath it, it will just Offset to the first of those blank cells beneath it and stop.
If I understand it correctly...
You'll need to convert hard coded ranges to variables
You are using offset correctly
I know while/wend is outdated, sorry :)
Sub IsNumeric()
dim tc as range
set tc = range("B6") 'this is always column B, but the row keeps changing in the loop
'IF(ISNUMBER(C6),C6,
while tc <> ""
If Application.IsNumber(tc.offset(0,1).Value) Then
tc.offset(0,2).Value = tc.offset(0,1)
'IF(C6<C5,((OFFSET(C6,2,0)-OFFSET(C6,-1,0))*A6/3+OFFSET(C6,-1,0)),
If tc.offset(0,1) < tc.offset(-1,1) Then
tc.offset(0,2).Value = tc.Offset(2, 1) - tc.Offset(-1, 1) * (tc.offset(0,-1) / 3) + tc.Offset(-1, 1)
'IF(C6<>C7,((OFFSET(C6,1,0)-OFFSET(C6,-2,0))*(A6/3)+OFFSET(C6,-2,0)),"")))
If tc.offset(0,1) <> tc.offset(1,1) Then
tc.offset(0,2) = tc.offset(1,1) - tc.offset(-2,1) * (tc.offset(0,-1) / 3) + tc.offset(-2,1)
Else
tc.offset(0,2) = ""
End If
End If
End If
set tc=tc.offset(1,0)
wend
End Sub