I want to automate a calculation for a measurement data Excel file.
While I made the function work, I could only figure out how to do that for one row at a time. The calculation is specific to the data on every row.
I thought I could change the Range("J3") value to Range("J3:J52") for a capacity of 50 calculations.
How do I make the function calculate for every row, separately, using the data of said specific row?
It doesn't matter if it runs for all 50 rows or if I have to figure out some loop function to find how many rows to calculate for, as long as one button press in the end will make the magic happen.
I have included a screenshot of the sheet for reference, the main calculation is done in Excel, but what this is doing is choosing the correct option out of a few different correction calculations and explaining to the user why.
I think there are some unnecessary Dim lines at the start but if it runs, I wasn't going to remove them.
'The main function, activated by a simple button Sub'
Function ISO16032()
'DeltaL Range'
Dim DeltaL As Range
Set DeltaL = Range("F3")
'Result is the corrected value in G column'
Dim Result As Long
'Note is the calc note in H column'
Dim Note As String
'X is the DeltaL between noise and background noise'
Dim x As Long
x = Range("F3").Value
Select Case Range("F3").Value
'No correction when X = > 10'
Case 10.6 To 200
Result = Range("J3")
Range("G3").Value = Result
Note = "No correction"
Range("H3").Value = Note
'Correction according to ISO16032 when X = between 4 and 10'
Case 3.6 To 10.5
Result = Range("K3")
Range("G3").Value = Result
Note = "Correction per ISO16032"
Range("H3").Value = Note
'Maximal correction value set to 2,2 dB if X < 4'
Case 0.1 To 3.5
Result = Range("L3")
Range("G3").Value = Result
Note = "Correction limit set to 2,2 dB"
Range("H3").Value = Note
'If x = < 0, the measurement is invalid'
Case Else
Note = "Repeat measurement!"
Range("H3").Value = Note
End Select
End Function
Hi and welcome to stackoverflow, I think that a simple loop, with the addition of an argument to your ISO function allows you to solve your problem like this
Sub Looping()
For i = 3 To 52
' Convert i to String because we need to concatenate with the letter F, G, H...
Call ISO16032(CStr(i))
Next
End Sub
Function ISO16032(Cell_X)
'DeltaL Range'
Dim DeltaL As Range
Set DeltaL = Range("F" + Cell_X)
'Result is the corrected value in G column'
Dim Result As Long
'Note is the calc note in H column'
Dim Note As String
'X is the DeltaL between noise and background noise'
Dim x As Long
x = Range("F" + Cell_X).Value
Select Case Range("F" + Cell_X).Value
'No correction when X = > 10'
Case 10.6 To 200
Result = Range("J" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "No correction"
Range("H" + Cell_X).Value = Note
'Correction according to ISO16032 when X = between 4 and 10'
Case 3.6 To 10.5
Result = Range("K" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "Correction per ISO16032"
Range("H" + Cell_X).Value = Note
'Maximal correction value set to 2,2 dB if X < 4'
Case 0.1 To 3.5
Result = Range("L" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "Correction limit set to 2,2 dB"
Range("H" + Cell_X).Value = Note
'If x = < 0, the measurement is invalid'
Case Else
Note = "Repeat measurement!"
Range("H" + Cell_X).Value = Note
End Select
End Function
EDIT: think indented your code like I did to make it more readable too (or like #Darren Bartrup-Cook did when editing your question)
This is more of an example of how to calculate each row.
Just getting your code to work across multiple rows.
Cells
With...End With Statement
'No need for Sub to call function that doesn't return anything.... just write a sub.
Public Sub ISO16032()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, 10).End(xlUp).Row
Dim RowCounter As Long
Dim Result As Long
Dim Note As String
'Only calculate if there is data in rows 3 onwards.
If LastRow >= 3 Then
'Reset results on each pass.
'Assuming -1 is an impossible answer so code knows
'not to put anything on Case Else.
Result = -1
Note = ""
'Cycle through each row and calculate.
For RowCounter = 3 To LastRow
Select Case .Cells(RowCounter, 6) 'Look at column F(column 6) on each row.
Case 10.6 To 200
Result = .Cells(RowCounter, 10)
Note = "No corrections."
Case 3.6 To 10.5
Result = .Cells(RowCounter, 11)
Note = "Correction per ISO16032"
Case 0.1 To 3.5
Result = .Cells(RowCounter, 12)
Note = "Correction limit set to 2,2 dB"
Case Else
Note = "Repeat measurement!"
End Select
'Place results on sheet.
.Cells(RowCounter, 7) = IIf(Result >= 0, Result, "")
.Cells(RowCounter, 8) = Note
Next RowCounter
End If
End With
End Sub
I ran into a problem when I try to add the first 10 even numbers in a column regardless of the number of inputs someone has entered into said column.
The issue occurs when there are less than 10 inputs (in my case 7) and I have tried to break the loop if there are no more numbers after the last one but it doesn't seem to work as it crashes Excel; most probably because it loops infinitely.
The original code was fine until I entered below 10 even numbers. When I did it would loop infinitely and crash so I inputted a forceful break in the code (hence the Count=999) but it does not seem to work
Sub TenPosInt()
Dim Total As Integer, size As Integer, myRange As range
Dim Count As Integer
Count = 1
Set myRange = range("W:W")
size = WorksheetFunction.CountA(myRange)
While Count <= 10
If IsEmpty(Cells(Count, "W")) Then
Count = 999
End If
If Cells(Count, "W").Value Mod 2 = 0 Then
Total = Total + Cells(Count, "W").Value
Count = Count + 1
End If
Wend
MsgBox Total
End Sub
My Inputs are currently 2,4,6,5,2,4,6,8,1,3,5 so it does not meet the 10 even integers, however I still want it to run regardless (hence the Count=999 line). The correct return should be 32.
A Do-While/Until loop is recommended instead of While-Wend (see this).*
Here I use a separate counter for row and the number of even values (and stole David's idea of combining the two conditions in the Do line).
Sub TenPosInt()
Dim Total As Long, r As Long, Count As Long
r = 1
Do Until Count = 10 Or Cells(r, "W") = vbNullString
If Cells(r, "W").Value Mod 2 = 0 Then
Total = Total + Cells(r, "W").Value
Count = Count + 1
End If
r = r + 1
Loop
MsgBox Total & " (" & Count & " even numbers)"
End Sub
*Actually I would be more inclined to use one of the other gent's answers, but I have tried to stick as close to yours as possible. (Also a good idea to check a cell is numeric before checking for even-ness.)
Just for fun - here is an approach that uses a For...Next loop, allows for non-numeric entries in Column W, and handles the possibility of blank rows between entries.
Sub TenPosInt()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "W").End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
If Not IsEmpty(Cells(i, "W")) Then
If IsNumeric(Cells(i, "W")) Then
If Cells(i, "W").Value Mod 2 = 0 Then
Dim counter As Long
counter = counter + 1
Dim total As Long
total = total + Cells(i, "W").Value
If counter = 10 Then Exit For
End If
End If
End If
Next
MsgBox total
End Sub
Why not use a standard for loop across a range? this would give more specific inputs for the subroutine.
Description of what is occuring below has been commented out to allow for copy/pasting more easily.
'Define your range (you use columns("W"), but narrow that)... assuming you start in row 2 (assumes row 1 is headers), move to the last row, of the same columns:
lr = cells(rows.count,"W").end(xlup).row
'so you know the last row, loop through the rows:
for i = 2 to lr
'Now you will be doing your assessment for each cell in column "W"
if isnumeric(cells(i,"W").value) AND cells(i,"W").value mod 2 = 0 then
s = s + cells(i,"W").value
counter = counter + 1
if counter = 10 then exit for
end if
'Do that for each i, so close the loop
next i
'You now have determined a total of 10 items in the range and have added your items. Print it:
debug.print s
Edit1: got a comment to not break-up the code in an explanatory fashion, so I have added ' to comment out my explanations in an effort to make my coding portion copy/pasteable as a lump.
Does anyone have an Excel VBA function which can return the column letter(s) from a number?
For example, entering 100 should return CV.
This function returns the column letter for a given column number.
Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function
testing code for column 100
Sub Test()
MsgBox Col_Letter(100)
End Sub
If you'd rather not use a range object:
Function ColumnLetter(ColumnNumber As Long) As String
Dim n As Long
Dim c As Byte
Dim s As String
n = ColumnNumber
Do
c = ((n - 1) Mod 26)
s = Chr(c + 65) & s
n = (n - c) \ 26
Loop While n > 0
ColumnLetter = s
End Function
Something that works for me is:
Cells(Row,Column).Address
This will return the $AE$1 format reference for you.
For example: MsgBox Columns( 9347 ).Address returns .
To return ONLY the column letter(s): Split((Columns(Column Index).Address(,0)),":")(0)
For example: MsgBox Split((Columns( 2734 ).Address(,0)),":")(0) returns .
And a solution using recursion:
Function ColumnNumberToLetter(iCol As Long) As String
Dim lAlpha As Long
Dim lRemainder As Long
If iCol <= 26 Then
ColumnNumberToLetter = Chr(iCol + 64)
Else
lRemainder = iCol Mod 26
lAlpha = Int(iCol / 26)
If lRemainder = 0 Then
lRemainder = 26
lAlpha = lAlpha - 1
End If
ColumnNumberToLetter = ColumnNumberToLetter(lAlpha) & Chr(lRemainder + 64)
End If
End Function
Just one more way to do this. Brettdj's answer made me think of this, but if you use this method you don't have to use a variant array, you can go directly to a string.
ColLtr = Cells(1, ColNum).Address(True, False)
ColLtr = Replace(ColLtr, "$1", "")
or can make it a little more compact with this
ColLtr = Replace(Cells(1, ColNum).Address(True, False), "$1", "")
Notice this does depend on you referencing row 1 in the cells object.
This is a version of robartsd's answer (with the flavor of Jan Wijninckx's one line solution), using recursion instead of a loop.
Public Function ColumnLetter(Column As Integer) As String
If Column < 1 Then Exit Function
ColumnLetter = ColumnLetter(Int((Column - 1) / 26)) & Chr(((Column - 1) Mod 26) + Asc("A"))
End Function
I've tested this with the following inputs:
1 => "A"
26 => "Z"
27 => "AA"
51 => "AY"
702 => "ZZ"
703 => "AAA"
-1 => ""
-234=> ""
This is available through using a formula:
=SUBSTITUTE(ADDRESS(1,COLUMN(),4),"1","")
and so also can be written as a VBA function as requested:
Function ColName(colNum As Integer) As String
ColName = Split(Worksheets(1).Cells(1, colNum).Address, "$")(1)
End Function
robertsd's code is elegant, yet to make it future-proof, change the declaration of n to type long
In case you want a formula to avoid macro's, here is something that works up to column 702 inclusive
=IF(A1>26,CHAR(INT((A1-1)/26)+64),"")&CHAR(MOD(A1-1,26)+65)
where A1 is the cell containing the column number to be converted to letters.
LATEST UPDATE: Please ignore the function below, #SurasinTancharoen managed to alert me that it is broken at n = 53.
For those who are interested, here are other broken values just below n = 200:
Please use #brettdj function for all your needs. It even works for Microsoft Excel latest maximum number of columns limit: 16384 should gives XFD
END OF UPDATE
The function below is provided by Microsoft:
Function ConvertToLetter(iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function
Source: How to convert Excel column numbers into alphabetical characters
APPLIES TO
Microsoft Office Excel 2007
Microsoft Excel 2002 Standard Edition
Microsoft Excel 2000 Standard Edition
Microsoft Excel 97 Standard Edition
This is a function based on #DamienFennelly's answer above. If you give me a thumbs up, give him a thumbs up too! :P
Function outColLetterFromNumber(iCol as Integer) as String
sAddr = Cells(1, iCol).Address
aSplit = Split(sAddr, "$")
outColLetterFromNumber = aSplit(1)
End Function
There is a very simple way using Excel power: Use Range.Cells.Address property, this way:
strCol = Cells(1, lngRow).Address(xlRowRelative, xlColRelative)
This will return the address of the desired column on row 1. Take it of the 1:
strCol = Left(strCol, len(strCol) - 1)
Note that it so fast and powerful that you can return column addresses that even exists!
Substitute lngRow for the desired column number using Selection.Column property!
Here is a simple one liner that can be used.
ColumnLetter = Mid(Cells(Row, LastColA).Address, 2, 1)
It will only work for a 1 letter column designation, but it is nice for simple cases. If you need it to work for exclusively 2 letter designations, then you could use the following:
ColumnLetter = Mid(Cells(Row, LastColA).Address, 2, 2)
This will work regardless of what column inside your one code line for cell thats located in row X, in column Y:
Mid(Cells(X,Y).Address, 2, instr(2,Cells(X,Y).Address,"$")-2)
If you have a cell with unique defined name "Cellname":
Mid(Cells(1,val(range("Cellname").Column)).Address, 2, instr(2,Cells(1,val(range("Cellname").Column)).Address,"$")-2)
So I'm late to the party here, but I want to contribute another answer that no one else has addressed yet that doesn't involve arrays. You can do it with simple string manipulation.
Function ColLetter(Col_Index As Long) As String
Dim ColumnLetter As String
'Prevent errors; if you get back a number when expecting a letter,
' you know you did something wrong.
If Col_Index <= 0 Or Col_Index >= 16384 Then
ColLetter = 0
Exit Function
End If
ColumnLetter = ThisWorkbook.Sheets(1).Cells(1, Col_Index).Address 'Address in $A$1 format
ColumnLetter = Mid(ColumnLetter, 2, InStr(2, ColumnLetter, "$") - 2) 'Extracts just the letter
ColLetter = ColumnLetter
End Sub
After you have the input in the format $A$1, use the Mid function, start at position 2 to account for the first $, then you find where the second $ appears in the string using InStr, and then subtract 2 off to account for that starting position.
This gives you the benefit of being adaptable for the whole range of possible columns. Therefore, ColLetter(1) gives back "A", and ColLetter(16384) gives back "XFD", which is the last possible column for my Excel version.
Easy way to get the column name
Sub column()
cell=cells(1,1)
column = Replace(cell.Address(False, False), cell.Row, "")
msgbox column
End Sub
I hope it helps =)
The solution from brettdj works fantastically, but if you are coming across this as a potential solution for the same reason I was, I thought that I would offer my alternative solution.
The problem I was having was scrolling to a specific column based on the output of a MATCH() function. Instead of converting the column number to its column letter parallel, I chose to temporarily toggle the reference style from A1 to R1C1. This way I could just scroll to the column number without having to muck with a VBA function. To easily toggle between the two reference styles, you can use this VBA code:
Sub toggle_reference_style()
If Application.ReferenceStyle = xlR1C1 Then
Application.ReferenceStyle = xlA1
Else
Application.ReferenceStyle = xlR1C1
End If
End Sub
Furthering on brettdj answer, here is to make the input of column number optional. If the column number input is omitted, the function returns the column letter of the cell that calls to the function. I know this can also be achieved using merely ColumnLetter(COLUMN()), but i thought it'd be nice if it can cleverly understand so.
Public Function ColumnLetter(Optional ColumnNumber As Long = 0) As String
If ColumnNumber = 0 Then
ColumnLetter = Split(Application.Caller.Address(True, False, xlA1), "$")(0)
Else
ColumnLetter = Split(Cells(1, ColumnNumber).Address(True, False, xlA1), "$")(0)
End If
End Function
The trade off of this function is that it would be very very slightly slower than brettdj's answer because of the IF test. But this could be felt if the function is repeatedly used for very large amount of times.
Here is a late answer, just for simplistic approach using Int() and If in case of 1-3 character columns:
Function outColLetterFromNumber(i As Integer) As String
If i < 27 Then 'one-letter
col = Chr(64 + i)
ElseIf i < 677 Then 'two-letter
col = Chr(64 + Int(i / 26)) & Chr(64 + i - (Int(i / 26) * 26))
Else 'three-letter
col = Chr(64 + Int(i / 676)) & Chr(64 + Int(i - Int(i / 676) * 676) / 26)) & Chr(64 + i - (Int(i - Int(i / 676) * 676) / 26) * 26))
End If
outColLetterFromNumber = col
End Function
Function fColLetter(iCol As Integer) As String
On Error GoTo errLabel
fColLetter = Split(Columns(lngCol).Address(, False), ":")(1)
Exit Function
errLabel:
fColLetter = "%ERR%"
End Function
Here, a simple function in Pascal (Delphi).
function GetColLetterFromNum(Sheet : Variant; Col : Integer) : String;
begin
Result := Sheet.Columns[Col].Address; // from Col=100 --> '$CV:$CV'
Result := Copy(Result, 2, Pos(':', Result) - 2);
end;
This formula will give the column based on a range (i.e., A1), where range is a single cell. If a multi-cell range is given it will return the top-left cell. Note, both cell references must be the same:
MID(CELL("address",A1),2,SEARCH("$",CELL("address",A1),2)-2)
How it works:
CELL("property","range") returns a specific value of the range depending on the property used. In this case the cell address.
The address property returns a value $[col]$[row], i.e. A1 -> $A$1.
The MID function parses out the column value between the $ symbols.
Sub GiveAddress()
Dim Chara As String
Chara = ""
Dim Num As Integer
Dim ColNum As Long
ColNum = InputBox("Input the column number")
Do
If ColNum < 27 Then
Chara = Chr(ColNum + 64) & Chara
Exit Do
Else
Num = ColNum / 26
If (Num * 26) > ColNum Then Num = Num - 1
If (Num * 26) = ColNum Then Num = ((ColNum - 1) / 26) - 1
Chara = Chr((ColNum - (26 * Num)) + 64) & Chara
ColNum = Num
End If
Loop
MsgBox "Address is '" & Chara & "'."
End Sub
Column letter from column number can be extracted using formula by following steps
1. Calculate the column address using ADDRESS formula
2. Extract the column letter using MID and FIND function
Example:
1. ADDRESS(1000,1000,1)
results $ALL$1000
2. =MID(F15,2,FIND("$",F15,2)-2)
results ALL asuming F15 contains result of step 1
In one go we can write
MID(ADDRESS(1000,1000,1),2,FIND("$",ADDRESS(1000,1000,1),2)-2)
this is only for REFEDIT ... generaly use uphere code
shortly version... easy to be read and understood /
it use poz of $
Private Sub RefEdit1_Change()
Me.Label1.Caption = NOtoLETTER(RefEdit1.Value) ' you may assign to a variable var=....'
End Sub
Function NOtoLETTER(REFedit)
Dim First As Long, Second As Long
First = InStr(REFedit, "$") 'first poz of $
Second = InStr(First + 1, REFedit, "$") 'second poz of $
NOtoLETTER = Mid(REFedit, First + 1, Second - First - 1) 'extract COLUMN LETTER
End Function
Cap A is 65 so:
MsgBox Chr(ActiveCell.Column + 64)
Found in: http://www.vbaexpress.com/forum/showthread.php?6103-Solved-get-column-letter
what about just converting to the ascii number and using Chr() to convert back to a letter?
col_letter = Chr(Selection.Column + 96)
Here's another way:
{
Sub find_test2()
alpha_col = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,W,Z"
MsgBox Split(alpha_col, ",")(ActiveCell.Column - 1)
End Sub
}