I just started VBA coding and I am struck here:
For one cell this program works:
Dim score As Integer, result As String
score = Range("A1").Value
If score >= 60 Then
result = "pass"
Else
result = "fail"
End If
Range("B1").Value = result
And how about a column of cells? Can loop works for this?
My code using loop - But How to define variable in range?
Dim score As Integer, result As String, I As Integer
score = Range("AI").Value
For I = 1 To 6
If score >= 60 Then
result = "pass"
Else
result = "fail"
End If
Range("BI").Value = result
Next I
Thanks in advance!
Almost, you just need to use string concatenation (&)
Dim score As Integer, result As String, I As Integer
'score = Range("AI").Value
For I = 1 To 6
score = Range("A" & I).Value '// Needs to be inside the loop to update.
If score >= 60 Then
result = "pass"
Else
result = "fail"
End If
Range("B" & I).Value = result
Next I
This can also be written as:
For i = 1 To 6
Range("B" & i).Value = IIf(Range("A" & i).Value >= 60, "pass", "fail")
Next
you can also go with a "formula" approach:
Range("B1:B6").FormulaR1C1 = "=If(RC1 >= 60, ""pass"", ""fail"")"
thus maintaining that check active for any possible subsequent change in columns A cells values
or, should you want to have "static" values only:
With Range("B1:B100")
.FormulaR1C1 = "=If(RC1 >= 60, ""pass"", ""fail"")"
.Value = .Value
End With
Related
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.
Basically I have 7 cells that could be populated with text (b2, b4, b6, b8, b10, b12 and b14). I want to the code to check each of the cells to see if they have a value and send only the cells that do have a value in an email. For formatting purposes the cells pasted into the email need to have one empty cell in between and the cells need to be kept in the order they are in originally, just without the unnecessary blank cells.
I've never officially learned VBA I've only taught myself on a case by case scenario so there could be an easy solution that I'm missing. Often I can debug and find the problem but in this case Excel completely freezes and turns "Not Responding". I have a feeling that means I've got a loop somewhere unresolved but I don't really understand how. The code -seems- to run up until Range("A2").Value = Line(LineCount1). Any suggestions would be appreciated.
Public Sub SingleEmail()
Dim LineCount1 As Integer
Dim LineCount2 As Integer
Dim LineCount3 As Integer
Dim LineCount4 As Integer
Dim LineCount5 As Integer
Dim LineCount6 As Integer
Dim LineCount7 As Integer
Dim NumOfLines As Integer
Range("A2", "A14").ClearContents
LineCount1 = 2
Range("A2").Value = Line(LineCount1)
LineCount2 = 2 + LineCount1
Range("A4").Value = Line(LineCount2)
LineCount3 = 2 + LineCount2
Range("A6").Value = Line(LineCount3)
LineCount4 = 2 + LineCount3
Range("A8").Value = Line(LineCount4)
LineCount5 = 2 + LineCount4
Range("A10").Value = Line(LineCount5)
LineCount6 = 2 + LineCount5
Range("A12").Value = Line(LineCount6)
LineCount7 = 2 + LineCount6
Range("A14").Value = Line(LineCount7)
NumOfLines = Range("n3").Value
If Range("A2") <> "" Then
Range("A2", "A" & NumOfLines).Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Introduction = ""
.Item.To = "personalemailaddress#Someplace.com"
.Item.CC = ""
.Item.Subject = "Email Subject"
.Item.send
End With
End If
End Sub
Function Line(ByRef LineCount As Integer) As String
Line = ""
Do While Line = "" Or LineCount < 13
If Range("B" & LineCount).Value <> "" Then
Line = Range("B" & LineCount).Value
Else
LineCount = LineCount + 2
End If
Loop
End Function
To answer your question:
If B4 has value and B2 is blank then this While loop become infinite. the LineCount is Stuck on 4, hence no overflow. That's why your code freezes.
Why are you running a loop in the first place. You can simply assign the values like this Range("A2:A14").Value =Range("B2:B14").Value
As per your comment, you need to use And operator in place of OR
Do While Line = "" And LineCount < 13 now the loop will exit if line <> "" or LineCount > 14
I have a large table, sometimes with hundreds of rows.
This table is generated by another application that exports to excel.
One column has the heading "Adjusted Price".
I want all the rows in this column to contain a formula (presently they're all 0's).
I want to automate this process because the table gets regenerated all the time.
This column may not always be in the same place. So I need a macro that can find this column ("Adjusted Price") and then fill all the cells in that column with a formula (with the exception of the first row of course).
Can this be done?
Thanks in advance :)
Your homework is to figure out how to plug it in!
Option Explicit
Sub setAdjustedPrice()
Dim column As Integer
Dim adjustedPriceColumn As String
Dim found As Boolean
Dim rowCount As Long
column = 1
rowCount = 1
Do While Range(FncAlphaCon(column) & rowCount).Value <> "" And found = False
If (Range(FncAlphaCon(column) & rowCount).Value = "Adjusted Price") Then
found = True
adjustedPriceColumn = FncAlphaCon(column)
Else
column = column + 1
End If
Loop
If found = True Then
Do While rowCount < ActiveSheet.UsedRange.Rows.count
rowCount = rowCount + 1
Range(adjustedPriceColumn & rowCount) = "YOUR FORMULA"
Loop
Else
MsgBox ("'Adjusted Price' column not found, cannot continue.")
End If
End Sub
Private Function FncAlphaCon(aNumber As Integer) As String
' Fixed version 27/10/2011
Dim letterArray As String
Dim iterations As Integer
letterArray = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If aNumber <= 26 Then
FncAlphaCon = (Mid$(letterArray, aNumber, 1))
Else
If aNumber Mod 26 = 0 Then
iterations = Int(aNumber / 26)
FncAlphaCon = (Mid$(letterArray, iterations - 1, 1)) & (Mid$(letterArray, 26, 1))
Else
'we deliberately round down using 'Int' as anything with decimal places is not a full iteration.
iterations = Int(aNumber / 26)
FncAlphaCon = (Mid$(letterArray, iterations, 1)) & (Mid$(letterArray, (aNumber - (26 * iterations)), 1))
End If
End If
End Function
I am having a problem running the code below, the code is to calculate the difference between two array of dates, values is separted by line carriage (CHR(10)), for example in cell A1 I have the following dates
A1
12/12/2012
11/12/2021
7/8/2015
9/4/2014
B1
12/12/2012
11/12/2021
7/8/2015
9/4/2014
C1
2D
1D
4D
10D
in D1 I call the function from which is inside module 1 as following
=calcSumDurations(A1,B1,C1)
it will always return 0
and when I try to trace the code, it will enter the for loop only once, even than intmax = 3, or 4 or 40 in some cases, I tried while, for, foreach, none working.
Function calcSumDurations(dateFrom, dateTo, dateDuration As String)
Dim intmax, intSum, i, intError As Integer
Dim varDateFrom, varDateTo, varDateDuration As Variant
intSum = 0
intmax = -1
i = 0
intError = 0
varDateFrom = Split(dateFrom, Chr(10))
varDateTo = Split(dateTo, Chr(10))
varDateDuration = Split(dateDuration, Chr(10))
intmax = UBound(varDateFrom)
If UBound(varDateFrom) = UBound(varDateTo) Then ' both are same lenght
If intmax >= 0 Then ' more than one line
For i = 0 To intmax
'While i < intmax
MsgBox (i)
If CInt(CDate(varDateTo(i))) >= CDate(varDateFrom(i)) Then 'check dates are more
If testDate(CStr(varDateTo(i))) And testDate(CStr(varDateFrom(i))) Then
intDuration = Abs(CInt(CDate(varDateTo(i)) - CDate(varDateFrom(i)))) + 1
intSum = intSum + intDuration
'strRes = strRes & CStr(intDuration) & Chr(10)
Else
intError = 1
'Exit For
End If
Else
intError = 2
End If
Next i
End If
Else
intError = 3
End If
calcSumDurations = intSum
End Function
The problem is in this line of code:
If CInt(CDate(varDateTo(i))) >= CDate(varDateFrom(i)) Then
an integer is too small to hold the date value and is causing an overflow exception. I'm not sure why you're trying to convert it into an integer anyways as the comparison won't work if you do that.
Try this:
If CDate(varDateTo(i)) >= CDate(varDateFrom(i)) Then
It'll at least start getting through the loop.
I'd also define what you want the function to return
Function calcSumDurations(dateFrom As String, dateTo As String, dateDuration As String) As Long
I am trying to add the following logic to a macro in Excel from a SQL proc and am having trouble converting it:
CASE WHEN Dept < '600' THEN '0' + convert(varchar,RTRIM(Dept))
when Dept between '650' and '899' THEN convert(varchar,RTRIM(Dept)) + '0'
ELSE convert(varchar,RTRIM(Dept)) + '0' END As Dept_Num
The display I desire is this:
If the Dept number in Table1[DEPT1] is between 0 and 599, then add a
leading zero, aka 001 becomes 0001.
If the Dept number in Table1[DEPT1] is between 650 and 899, then add
a following zero, aka 650 becomes 6500.
If the Dept number in Table1[DEPT1] is any other number, add a
following zero, aka 600 becomes 6000.
Dim deptnum As Integer, result As String
deptnum = Range("Table1[Dept1]").Value
If deptnum < 600 Then deptnum = Left(Range("Table1[Dept1]") & "0000", 4)
Ifelse deptnum = Right(Range("Table1[Dept1]") & "0000", 4)
As you can see, I am struggling with the concept of multiple conditions and this is my first time writing a statement like this...any help is appreciated!
Dim varcell as Variant
For Each varcell in ThisWorkbook.Sheets("DeptData").ListObjects(1).ListColumns(8).DataBodyRange
If varcell.value < 600 Then
varcell.value = "0" & cstr(varcell.value)
Else
varcell.value = cstr(varcell.value) & "0"
End If
Next
Please note that we need to update the points where the ' is.
Sub Testdeptnum()
Dim deptnum As Integer
Dim result As String
Dim deptrng As Range
Dim SourceSheet As Worksheet
Set SourceSheet = ThisWorkbook.Sheets("Data")
Set deptrng = SourceSheet.Range("DEPT1")
For Each c In deptrng.Cells
If c.Value < 600 Then
deptnum = c.Value
result = "0" & deptnum
SourceSheet.Cells(c.Row, 2).NumberFormat = "00##"
SourceSheet.Cells(c.Row, 2).Value = result
ElseIf c.Value > 650 And c.Value < 899 Then
deptnum = c.Value
result = deptnum & "0"
SourceSheet.Cells(c.Row, 2).NumberFormat = "00##"
SourceSheet.Cells(c.Row, 2).Value = result
Else
deptnum = c.Value
result = deptnum & "0"
SourceSheet.Cells(c.Row, 2).NumberFormat = "00##"
SourceSheet.Cells(c.Row, 2).Value = result
End If
Next c
End Sub
I'm not entirely sure what the format of your Table1 data is in thus I can't really be sure what format it needs to be targeting, etc.
The gist of it is this: you need to iterate through the cells, not the range. The range.value can't return a value for each cell, it will return a single value. In order to evaluate the individual value of each cell in a range, you have to step through the range in a loop (I used a For Each).
Keep in mind, your results may vary depending on what format your workbook/data is in. Here my "Table1" is assumed to be a Worksheet named "Data" which you can replace as you need to. If Table1 is your workbook or file name, you don't need to include it at all unless you also interact with another file/workbook within your same function/module.
Looks like you're just missing a few keywords. Also, formatting this in the below manner will make this more obvious:
Dim deptnum As Integer, result As String
deptnum = Range("Table1[Dept1]").Value
If deptnum < 600 Then
deptnum = Left(Range("Table1[Dept1]") & "0000", 4)
Else
deptnum = Right(Range("Table1[Dept1]") & "0000", 4)
End If