I wrote if condition which is shown below, it looks for value "Current Status:" in row A and copy B value from that row to other sheet, if not not found "0" is placed in a cell, it works fine. Sometimes value "Current Status:" might be in a different cell than A18, it might show up in the range from A16 to A20, how can I modify that code to find it within the range and copy corresponding value?
If ws.Range("A18") = "Current Status:" Then
.Range("V" & NewRow) = ws.Range("B18")
Else
.Range("V" & NewRow) = "0"
End If
Just put your code in a For loop... or use VLookup like Scotty suggested. It's basically the same thing. A For loop is more flexible but less optimized (VLookup is faster). They both run on the order of fractions of a μs/cell.
For Each c In Range("A16:A20")
If c.Value2 = "Current Status:" Then
.Range("V" & NewRow) = c.Offset(0, 1)
Exit For
Else
.Range("V" & NewRow) = "0"
End If
Next
If using a For loop, this is a little bit more code than what's above but a better structure...
'Define a value holder variable where it's scope makes sense
Dim NewValue As String
'... other code here ...
'Default: NewValue = ""
NewValue = ""
For Each c In Range("A16:A20")
If c.Value2 = "Current Status:" Then
NewValue = c.Offset(0, 1)
'Exit For is optional in this case. It matters if
'there are multiple matches... do you want first or last result?
Exit For
End If
Next
'Assign NewValue to cell
.Range("V" & NewRow) = NewValue
Use Vlookup:
.Range("V" & NewRow) = "0"
On Error Resume Next
.Range("V" & NewRow) = Application.WorksheetFunction.VLookup("Current Status:", ws.Range("A:B"), 2, False)
On Error GoTo 0
This will put 0 in the cell then try to replace it with the value returned from the vlookup. If "Current Status:" is not found in column A on ws then it will throw an error and be ignored leaving 0 in the cell.
If the value is found it will return the value in Column B and put that in place of the 0
Related
I am very new to Excel, VBA, Macro. My macro was working fine because I gave a simple formula, for example, D2(column name)-C2(column name) = Total time in HH:MM format new column. But I notice for some output is just #### not sure what is wrong. 1).Column)).Formula = _
"=" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(2, col1).Address(0, 0)
cl.Offset(, 1).EntireColumn.NumberFormat = "[hh]:mm"
The issue occurs because your date in J is earier than in I and therefore the result is negative. You can use the ABS() function to get the absolute difference as positive value.
Therefore adjust your formula as below:
.Formula = "=ABS(" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(2, col1).Address(0, 0) & ")"
You have an incorrect formula in this line:
.Range(cl.Offset(1, 1), .Cells(lastR, cl.Offset(1, 1).Column)).Formula = _
"=" & cl.Offset(1, 0).Address(0, 0) & "-" & .Cells(**2**, col1).Address(0, 0)
Why .Cells(2, col1)? This is always giving you row2 of column 1.
Also, after this line:
If cl.Value = "Full Out Gate at Inland or Interim Point (Destination)_recvd"
Then
Add:
If cl.Offset(0,1).Value = "Response Time" Then Exit For
This will keep you from inserting a new column every time you run the macro.
Try using clear variable names and consistent method for referring to rows and columns.
actCol = col1
recvdCol = cl.Column
responseCol = cl.offset(0,1).Column
.Range(lastR, responseCol).Formula = _
"= Abs(" & .Cells(lastR, recvdCol) & "-" & .Cells(lastR, actCol).Address(0, 0) & ")"
I would use a simpler approach. Highlight the entire table, and click "Format as Table", and be sure to check off "My table has headers." This will give you a named range (default name is Table1, but you can change it). Then, in the Response Time column, simply enter your formula on the first row of the table, but use your mouse to select the cells instead of typing in a cell name like "I2". You will find that the resulting formula includes something like =[#actl]-[#recvd], except that the actl and recvd will be replaced by your actual column names. And, the formula will apply to every row of the table. If you add a new row, the formula will automatically appear in that row. No code needed.
If you have a reason to use code instead of a Table (named ranges), then I would recommend (1) this code be placed directly in the "Main" worksheet module and (2) use use the "Worksheet_Changed" procedure. Microsoft Excel VBA Reference. In this case, any time the
Private Sub Worksheet_Change(ByVal Target As Range)
'Note, Target is the Range of the cell(s) that just changed.
If Intersect(Target, Range("A1:A10")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If ActiveSheet.Cells(1, Target.Column) = "Full Out Gate at Inland or Interim Point (Destination)_actual" Then
' Cell in actual column was modified. Let's set the formula in the Response Time column:
On Error Goto EH
Application.EnableEvents = False
' Add your code here. You'll need to modify it somewhat to accommodate this methodology.
Application.EnableEvents = True
End If
EH:
Application.EnableEvents = True
Err.Raise ' expand this to whatever error you wish to raise
End Sub
Err.Raise help
I have a vba function that receives a row from a workbook and looks in come columns for data, setting variables or not depending on what is found. For rows 2-16, everything works fine; empty cells get skipped. Suddenly on row 17, a cell which seems empty triggers the first if-condition.
I've tried adding an additional check for cells that contain an empty string, and in the worksheet itself I checked CODE(H17) which was #VALUE
Function calcID(r As Long) As Variant
If (Not IsEmpty(allProps.Cells(r, 8))) Or (Not allProps.Cells(r, 8).Value = "") Then
MsgBox "Found ID: " & allProps.Cells(r, 8).Value & " in allProps row " & r
calcID = CDate(allProps.Cells(r, 8).Value)
ElseIf Not IsEmpty(allProps.Cells(r, 9)) Or Not allProps.Cells(r, 9).Value = "" Then
MsgBox "Found reverse ID: " & allProps.Cells(r, 9).Value & " in allProps row " & r
calcID = CDate(allProps.Cells(r, 9).Value)
Else
calcID = ""
End If
End Function
I use CDate elsewhere and it works fine. Ultimately the error shows up once I'm inside the if because I think CDate doesn't have a string to work with.
I think you only want to process the cells if they are both non-empty AND not equal to emptystring. This will prevent strange behavior if a cell is somehow not empty but is equal to emptystring.
Change your logical ORs to ANDs.
Function calcID(r As Long) As Variant
If (Not IsEmpty(allProps.Cells(r, 8))) And (Not allProps.Cells(r, 8).Value = "") Then
MsgBox "Found ID: " & allProps.Cells(r, 8).Value & " in allProps row " & r
calcID = CDate(allProps.Cells(r, 8).Value)
ElseIf Not IsEmpty(allProps.Cells(r, 9)) And Not allProps.Cells(r, 9).Value = "" Then
MsgBox "Found reverse ID: " & allProps.Cells(r, 9).Value & " in allProps row " & r
calcID = CDate(allProps.Cells(r, 9).Value)
Else
calcID = ""
End If
End Function
Some of the value in the cell which starts with = is taken as formula in excel.
For eg : =test is taken as a formula with error like this in excel.
I do had a similar issue and sorted it out by comparing the value in the cell and trimming off unwanted = in cell value.
Please make sure you are not getting any value in that cell which makes excel think that it is a formula or cell reference.
I'm attempting to create a form for data entry of lab results, which validates an answer based on the specification of the product tested. The user enters the following information: Product Code and SG result etc
My source data is a table with 4 columns,
Product Code, Description, SG low, SG high
SOURCE
When the user enters the Product Code and SG in the form I would like it to validate based on the specific range allowed for that product (from the source data), and have a dialogue box asking the user to reconsider the result entered (if it were outside of the range).
Easy enough to flag with conditional formatting in the results sheet, but I don't want my users to have access to it.
RESULTS
I need to refer to separate Range VLOOKUP to return the specs.
THE FORM
Thanks in advance!
(update)
Private Sub CommandButton1_Click()
Dim i As Integer
i = 2
While ThisWorkbook.Worksheets("Sheet2").Range("A" & i).Value <> ""
i = i + 1
Wend
Dim losg, loph, hisg, hiph As Double
losg = Application.WorksheetFunction.VLookup(ProdCode.Text, Sheet1.Range("A1:F24"), 3, False)
hisg = Application.WorksheetFunction.VLookup(ProdCode.Text, Sheet1.Range("A1:F24"), 4, False)
loph = Application.WorksheetFunction.VLookup(ProdCode.Text, Sheet1.Range("A1:F24"), 5, False)
hiph = Application.WorksheetFunction.VLookup(ProdCode.Text, Sheet1.Range("A1:F24"), 6, False)
If SGresult.Text < losg Then
MsgBox "SG result " & SGresult.Text & " too low"
ElseIf SGresult.Text > hisg Then
MsgBox "SG result " & SGresult.Text & " too high"
Else: MsgBox "SG result " & SGresult.Text & " just right"
End If
If pHresult.Text < loph Then
MsgBox "ph result " & pHresult.Text & " too low"
ElseIf pHresult.Text > hiph Then
MsgBox "ph result " & pHresult.Text & " too high"
Else: MsgBox "ph result " & phresult.Text & " just right"
End If
ThisWorkbook.Worksheets("Sheet2").Range("A" & i).Value = ProdCode.Value 'Enter Code in Column A
ThisWorkbook.Worksheets("Sheet2").Range("C" & i).Value = BNenter.Value 'Enter BN in Column C
ThisWorkbook.Worksheets("Sheet2").Range("D" & i).Value = DOMenter.Value 'Enter DOM in Column D
ThisWorkbook.Worksheets("Sheet2").Range("E" & i).Value = SGresult.Value 'Enter SG result in Column E
ThisWorkbook.Worksheets("Sheet2").Range("F" & i).Value = pHresult.Value 'Enter pH result in Column F
ThisWorkbook.Worksheets("Sheet2").Range("K" & i).Value = BatcherID.Value 'Enter Batcher ID in Column K
End Sub
Save Products in column "K" and valid result for respective product in column "L". Below code will give you desired output
Dim result, prod As String
Dim rng As Range
result = Val(resultText.Value)
prod = prodText.Value
ActiveSheet.Activate
On Error GoTo step:
Set rng = Range("K:K").Find(What:=prod, LookIn:=xlValues, LookAt:=xlWhole)
If rng.Offset(0, 1).Value <> result Then
MsgBox "The result entered is out of valid range!"
End If
Exit Sub
step:
MsgBox "Invalid Product"
Exit Sub
edited after OP clarified the "form" was a "UserFom"
You may want to check user input while he/she's editing/exiting any control instead of waiting for the CommandButton1_Click event and check them all together
Such a "modular" approach should keep code more easy to control and maintain
For example the TextBox Exit event could be used to check the user input as he/she's leaving it and have him/her come back to it in case of wrong input
Moreover
since "Product Code" must be chosen between those listed in "Source" worksheet column "A"
you may want to use a ComboBox control and have the user choose one out of a list
since "Product Name" must be the one corresponding to the chosen "Product Code"
you may want to use a Label control and have the user simply looks at what name corresponds to the product code he just chose
Following what above and assuming "ProductNameLbl" as the label name, your userform code could be something like follows:
Option Explicit
Private Sub UserForm_Initialize()
Me.ProdCodeCB.List = GetSourceData(1) '<--| fill Product Name combobox list with "Source" worksheet column 1 data
End Sub
Private Sub ProdCodeCB_Change() '<--| fires when the user change the combobox selection
Me.ProdNameLbl.Caption = Worksheets("Source").Cells(Me.ProdCodeCB.ListIndex + 2, 2) '<--| update Product Name label with the name corresponding to the chosen Product Code
End Sub
Private Sub SGresultTB_Exit(ByVal Cancel As MSForms.ReturnBoolean) '<--| fires upon exiting the SGresult textbox
Dim msgErr As String
With Me '<--| reference the Userform
If .ProdCodeCB.ListIndex <> -1 Then '<--| if a valid selection has been made in 'ProductCode' combobox
If Not IsValueInRange(.SGresultTB, GetProdCodeRange(.ProdCodeCB.ListIndex + 1), msgErr) Then '<-- if value out of range then...
With .SGresultTB
MsgBox "SG value " & .Value & msgErr _
& vbCrLf & vbCrLf & "Please reconsider the value you input in 'SG' texbox"
Cancel = True
.SetFocus '<--| get the user back to the textbox
' following two lines select the textbox text so that the user can delete it
.SelStart = 0
.SelLength = Len(.Text)
End With
End If
End If
End With
End Sub
'-------------------------------------------------
' helper functions
'---------------------------
Function GetSourceData(colIndex As Long)
' this function returns an array with "Source" worksheets data in passed column from its row 2 to last not empty one
With Worksheets("Source") '<--| reference "Source" worksheet
GetSourceData = Application.Transpose(.Range(.Cells(2, colIndex), .Cells(.Rows.Count, colIndex).End(xlUp)).Value)
End With
End Function
Function IsValueInRange(tb As MSForms.TextBox, rangeArr As Variant, msgErr As String) As Boolean
' this function returns a boolean (true/false) with the result of the checking whether the passed texbox (tb) text exceeds the passed range (rangeArr)
' msgErr is also set to some text if the range is exceeded
With tb
Select Case CDbl(.Value) '<-- prepare to act accordingly to its value
Case Is < rangeArr(1) '<--| if it's smaller than "SG Low" value
msgErr = " is lower than 'SG Low' = " & rangeArr(1) '<-- build the final part of the error message correspondingly
Case Is > rangeArr(2) '<--| while if it's greater than "SG High" value
msgErr = " is greater than 'SG High' = " & rangeArr(2) '<-- build the final part of the error message correspondingly
End Select
End With
IsValueInRange = msgErr = ""
End Function
Function GetProdCodeRange(iProd As Long)
' this function returns an array of the SG minimum and maximum values in "Source" worksheet corresponding to the chosen product
With Worksheets("Source") '<--| reference "Source" worksheet
With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its column "A" cels from row 2 down to last not empty one
GetProdCodeRange = Application.Transpose(Application.Transpose(.Cells(iProd, 1).Offset(, 2).Resize(, 2).Value)) '<--| return an array with "SG low" and "SG high" values corresponding to the product index passed
End With
End With
End Function
'-------------------------------------------------
as you may see, I named controls after the names you chose for them except for adding a suffix to tell what kind of control they are:
ProdCodeCB: "CB" -> it's a ComboBox control name
SGresultTB: "TB" -> it's a TextBox control name
ProdNameLbl: "Lbl" -> it's a Label control name
I have one column of data with either "UP", "DOWN" or "" as values. I am trying to write code that states that for all rows, if the first cell is "UP" then check the next rows until I come to either "DOWN" or "UP", i.e. if the next row has a "" then check the next row until I come to either a "DOWN" or "UP".
I am very new to VBA, and have tried various options, but seem to only be able to bring back where there are consecutive "UP"s or "DOWNS" rather than where there is an "UP", a number of rows of "" and then another "UP".
This is my code:
Range("z1:z250").Select
Selection.ClearContents
For Row = 2 To 250
If Range("Y" & Row).Value = "UP" Then
For sRow = 3 To 250
If Range("Y" & Row + 1).Value = "UP" Then
Range("Z" & Row) = "MT-UP"
ElseIf Range("Y" & Row + 1).Value = "" Then
End If
Next
End If
Next
End Sub
I have tried to add code such as For Each c in Range (“Y3”:”Y250”) but this doesn't make it find the next UP, and makes it very slow. I have also tried GoTo next cell (although seem to understand this is frowned upon!) but this doesn't work either. Any help appreciated.
Not 100% clear if this is what you want but take a look...
Instead of nested loops I used a flag to mark when a second consecutive "UP" was found before encountering a "DOWN". From your description it seems there's no need to check for empty cells ("").
Sub MTTest()
Dim Row As Long
Dim MTRow As Long
Dim MTFlag As Boolean
Range("Z1:Z250").ClearContents
For Row = 2 To 250
If Range("Y" & Row).Value = "UP" Then
If MTFlag = True Then
Range("Z" & MTRow) = "MT-UP"
MTFlag = Flase
Else
MTFlag = True
MTRow = Row
End If
Else
If Range("Y" & Row).Value = "DOWN" Then MTFlag = False
End If
Next
End Sub
i'm trying to get the value of one cell in a column (column B). this cell is in the same row as the last cell which has a value in another (column A)
maxrowina = ws.Range("A1").Offset(ws.Rows.Count - 1, 0).End(xlUp).Row
maxcellinb = "B" & str(maxrowina)
MsgBox (ws.Range(dbhobcell).Value)
but i keep on getting a runtime error: 91.
how can i do this?
Two things :)
1) You don't need str(maxrowina). You can use this
maxcellinb = "B" & maxrowina
2) Shouldn't MsgBox (ws.Range(dbhobcell).Value) be
MsgBox (ws.Range(maxcellinb).Value)
Complete Code
maxrowina = ws.Range("A1").Offset(ws.Rows.Count - 1, 0).End(xlUp).Row
maxcellinb = "B" & maxrowina
MsgBox (ws.Range(maxcellinb).Value)
Just a little tighter on the MaxRow code:
MaxRowInA = ws.Range("A" & Rows.Count).End(xlUp).Row
MsgBox ws.Range("B" & MaxRowInA).Value
Tigher still:
MsgBox ws.Range("A" & Rows.Count).End(xlUp).Offset(,1).Value