I have two files. One file is with specification, second with the reuslts. I've created UserForm where I can compare if result is within the specified range & result is assessed as OK or NOK.
Spec
Results
Results & specification is saved from excel to tables & from table are populated into UserForm. During this, I met situation where randowm result (not the same) is within the range of specification but final Judgment is NOK. All data (spec& results) are in "General" format.
UserForm
When I will write the same result manualy, then Judgment is OK. I have 14 windows which are working with below the same code (numbers are just different)
Private Sub txtVal14_AfterUpdate()
Val14 = CofC_FORM.txtVal14.Value
If CofC_FORM.Test14 <> "" Then
If CofC_FORM.Val14 >= CofC_FORM.Min14 Then
If CofC_FORM.Val14 <= CofC_FORM.Max14 Then
CofC_FORM.Jud14.Caption = "OK"
CofC_FORM.Jud14.BackColor = RGB(102, 255, 51)
Else: CofC_FORM.Jud14.Caption = "NOK"
CofC_FORM.Jud14.BackColor = RGB(255, 51, 0)
End If
Else: CofC_FORM.Jud14.Caption = "NOK"
CofC_FORM.Jud14.BackColor = RGB(255, 51, 0)
End If
Else: CofC_FORM.Jud14.Caption = ""
End If
End Sub
I thought there are string valuse to compare & I implemented in the step before below code to change string to the number:
For Each r In Sheets(i).Range("G23:G28").SpecialCells(xlCellTypeConstants)
r.Select
r.NumberFormat = "0.00"
String1 = r.Value
String1 = Replace(String1, ",", ".")
r.Value = CSng(String1)
Next r
Can someone help me ? Do you have any idea what could be the problem as I think, aboce code is OK.
Related
I'm trying to use a Vlookup function in order to find a copy of a State code on another worksheet. But the range is not matching up with the string. The range is literally just the 50 states and I'm trying to make it match.
I tried checking out to make sure that the state abbreviation was a string. I've also tried converting the range to a string, but that also caused an error. It's strange because if I just match the specific states together, it says that they equal.
Sub State_Assignment()
Application.ScreenUpdating = False
'On Error Resume Next
' State_Assignment Macro
Dim Counter As Integer
Counter = 1
Dim Other As Integer
Other = 0
Dim State As String
State = " "
'
'First, we will check for specialty brokers.
'Check if Specialty Broker requires a state to assign. In this case, we are making sure to include N and n as options, due to future proofing.
If Worksheets("SBSS_Assignment_Tool").Range("G3").Value = "None" Then
ElseIf CStr(Application.VLookup(G3, Worksheets("Special_Cases").Range("A3:A100"), 2)) = "N" Or CStr(Application.VLookup(G3, Worksheets("Special_Cases").Range("A3:A100"), 2)) = "n" Then
E5.Value = WorksheetFunction.VLookup(G3, Worksheets("Special_Cases").Range("A3:A100"), 3)
'If State is needed for Specialty Broker, make sure operator knows. In this case, we are making sure to include Y and y as options, due to future proofing.
ElseIf "Y" = CStr(Application.VLookup(G3, Worksheets("Special_Cases").Range("A3:A100"), 2)) Or "y" = CStr(Application.VLookup(G3, Worksheets("Special_Cases").Range("A3:A100"), 2)) Then
MsgBox ("State is reqired to assign SBSS for this broker.")
'This only leaves the case of Yes and the state is specified.
Else
' Select the cell of the Broker we are looking at.
Worksheets("Special_Cases").Activate
Range("A3:A100").Find(CStr(Application.VLookup(G3, Worksheets("Special_Cases").Range("A3:A100"), 1))).Select
' Now check to make sure the State isn't the cell in the same row as it.
If ActiveCell.Offset(0, 2) = Worksheets("SBSS_Assignment_Tool").Range(G20).Value Then
Worksheets("SBSS_Assignment_Tool").Range(J7).Value = ActiveCell.Offset(0, 3)
'See if there are more states to check, by seeing if there is a empty cell below. We use the Counter varible as future-proofing, so specialty brokers can have as many states as they need.
'The "Other" state specification can also be a problem, so if we see it, we will remeber it's cell and use it if none of the other states match up.
ElseIf ActiveCell.Offset(Counter, 0) = " " Then
If ActiveCell.Offset(Counter, 2) = Worksheets("SBSS_Assignment_Tool").Range(G20).Value Then
Worksheets("SBSS_Assignment_Tool").Range(J7).Value = ActiveCell.Offset(Counter, 3)
ElseIf ActiveCell.Offset(Counter, 2) = "Other" Then
Other = Counter
End If
Counter = Counter + 1
Else
'If we check all the states and none match, we use the "Other" cell.
Worksheets("SBSS_Assignment_Tool").Range(J7).Value = ActiveCell.Offset(Other, 3)
End If
End If
' Looks for State From Drop-Down List and Gather Rules From Cell To The Right of It
Worksheets("SBSS_Assignment_Tool").Range("J20") = Application.VLookup(Worksheets("SBSS_Assignment_Tool").Range("G20").Value, Worksheets("State_Assignments").Range("A2:A100"), 2)
'Check for Special Broker Rules, first ruling out the No's
MsgBox (CStr(Worksheets("SBSS_Assignment_Tool").Range("G20").Value) + " ")
State = Worksheets("SBSS_Assignment_Tool").Range("G20").Value
MsgBox (CStr(Worksheets("State_Assignments").Range("A16").Value) + " ") '
MsgBox (Worksheets("SBSS_Assignment_Tool").Range("G20").Value = Worksheets("State_Assignments").Range("A16").Value)
Dim X As Range
Set X = Worksheets("State_Assignments").Range("A1:A100")
MsgBox (Application.VLookup(State, Worksheets("State_Assignments").Range("A2:A51"), 3))
If Application.VLookup(Worksheets("SBSS_Assignment_Tool").Range("G20").Value, Worksheets("State_Assignments").Range("A1:A100"), 3) = "N" Then
Else
'Selec the cell of the SBSS
Worksheets("Special_Cases").Range("A1:AA1").Find(Application.VLookup(G20, Worksheets("State_Assignments").Range("A1:A100"), 3)).Select
J28.Value = ActiveCell.Offset(1, 0)
End If
The message boxes work, but once it gets the Vlookups is when it starts to flounder.
I have an excel udf as one of the columns of a listobj (excel table). When I refresh the table I get mixed results on whether the udf calculates or not. Some of the cells recaculate some return #value. If I select a #value cell and click in the formula bar and click the 'check' it evaluates correctly. Or if I copy it down the column it calculates correctly.
I've added a worksheet change event to .calculate the listobj.
Any advise is appreciated.
Here's my user defined function.
Function colorscore(dest, score)
Dim scr
scr = score
Select Case scr
Case Is = 99
srcred = 255
srcgreen = 0
srcblue = 0
Case Is > 0
srcred = (1 - scr) * 255
srcgreen = 255 - ((255 - 176) * scr)
srcblue = scr * 80
Case Else
srcred = 255
srcgreen = 255
srcblue = 255
End Select
dest.Parent.Evaluate "ChangeIt2(" & dest.Address(False, False) & "," _
& srcred & "," _
& srcgreen & "," _
& srcblue & "" _
& ")"
colorscore = "Changed sheet!" 'or whatever return value is useful...
End Function
Sub ChangeIt2(c1 As Range, c2red, c2green, c2blue)
c1.Interior.Color = RGB(c2red, c2green, c2blue)
End Sub
here's the worksheet change event
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.ListObject Is Nothing Then Exit Sub
ActiveSheet.EnableCalculation = False
ActiveSheet.EnableCalculation = True
End Sub
looks like you have 2 definitions of score: one is a parameter to the udf and the other is a defined named score.
Then you evaluate the defined name using [score] notation.
So Excel does not know that there is a dependency on defined name score and so the UDF does not recalc when you change defined name score
I have a number of items in cells that are separated by dashes. I'm trying to normalize the database by splitting rows so that each row contains only one entry. How do you find/count strings in Excel VBA. I know you can do values for whole cells with
myVar = Application.WorksheetFunction.COUNTIF(Range("A1:Z100"),"Value")
I need to search a single cell and find out how many hyphens there are. Example
123-456-789 = 2
9876-12 = 1
Using hint from ron's function above I've created this formula and it worked fine :
=LEN(A1) - LEN(SUBSTITUTE(A1, "-", ""))
This will count the number of hyphens in the activecell
Sub test()
a = Len(ActiveCell)
my_txt = Replace(ActiveCell, "-", "", 1, -1, vbTextCompare)
b = Len(my_txt)
numb_occur = a - b
End Sub
Here's the UDF to count single string occurence in string:
Option Explicit
Function COUNTTEXT(ref_value As Range, ref_string As String) As Long
Dim i As Integer, count As Integer
count = 0
If Len(ref_string) <> 1 Then COUNTTEXT = CVErr(xlErrValue): Exit Function
For i = 1 To Len(ref_value.value)
If Mid(ref_value, i, 1) = ref_string Then count = count + 1
Next
COUNTTEXT = count
End Function
Here's using Array formula:
=SUM(IF(ISERROR(SEARCH("-",MID(A1,ROW(INDIRECT("$1:$" & LEN(A1))),1))),0,1))
Entered using Ctrl+Shift+Enter.
Hope this helps.
I found this answer:
Sub xcountCHARtestb()
'If countCHAR(RANGE("aq528"), ".") > 0 Then 'YES
If countCHAR(Selection, ".") > 0 Then 'YES
MsgBox "YES" & Space(10), vbQuestion ', "title"
Else
MsgBox "NO" & Space(10), vbQuestion ', "title"
End If
End Sub
Sub xcountCHARtesta() 'YES
MsgBox "There are " & countCHAR(Selection, "test") & " repetitions of the character string", vbQuestion 'YES
End Sub
Function countCHAR(myString As String, myCHAR As String) As Integer 'as: If countCHAR(Selection, ".") > 1 Then selection OR RANGE("aq528") '"any char string"
countCHAR = UBound(split(myString, myCHAR)) 'YES
End Function
This code might be of your help .. you can also use it as a UDF... :)
Function CountHypens(rng_Src As Range) As Long
'A VARIANT FOR SPLITTING CELL CONTENTS
Dim var As Variant
On Error Resume Next
var = Split(rng_Src.Value, "-", , vbTextCompare)
If Err.Number <> 0 Then
Debug.Print "This cell does not have any hyphens."
Else
CountHypens = UBound(var)
End If
Err.Clear: On Error GoTo 0
End Function
Follow up to: davex, by davex.. :)
I had been looking all over trying to find a way to test same for find text string in a formula.
This answer seems to work correctly for both formulas / not & fits in a 1 liner..
(am still pretty novice at vba, let me know if any better way(s) ) thanks.
If countChar(UCase(Selection.Formula), UCase("offset")) > 0 Then 'YES (thee? answer, works for both formulas / not)
'If countChar(Selection.Formula, "OFFSET") > 0 Then 'yes
'If countChar(Cells(ActiveCell.row, Selection.Column).Formula, "OFFSET") > 0 Then 'yes
'If countChar(Cells(ActiveCell.row, "BG").Formula, "OFFSET") > 0 Then 'yes
'If countChar(UCase(Selection), UCase("OffSET")) > 0 Then 'yes but not work on formula
'If Selection.Formula Like "*offset*" Then 'no (for eq)
MsgBox "YES" & Space(15), vbQuestion
Else
MsgBox "NO" & Space(15), vbQuestion
End If
NOTE: in place of variable "BG" above, i use permanent work cells to improve use for column BG example, work cell A3 has / shows: BG:BG
=SUBSTITUTE(SUBSTITUTE(CELL("address",$BG3),"$",""),ROW(),"")&":"&SUBSTITUTE(SUBSTITUTE(CELL("address",$BG3),"$",""),ROW(),"")
you will also need to dim the work cell, at the top / before the vba:
Dim A3 As String
A3 = RANGE("A3")
pardon, tried 3 times to get all of code into 1 box. really suggest putting a code stop start icon in the toolbar.
I have searched everywhere for an answer to this issue and I am fairly new to VBA so I hope you can help. Below is the code.
If [e19].Value + [g19].Value = [c19].Value Then
[l19].Value = "Yes"
ElseIf [e19].Value = "N/A" Then
[l19].Value = "N/A"
**ElseIf Range("i18:i21, l18").Value = "{a}" Then**
l19.Value = "{b}"
The code wrapped in ** is where I am having my issue. Any ideas?
Thank you
You can't compare a range with a specific value.. You could take each cell inside a 'For Each xxx In Range.Cells...Next' statement to proceed to the comparison for each value inside the range, but note that each cell is compared individually, in turn. This code should work this way:
Sub zo()
If [e19].Value + [g19].Value = [c19].Value Then
[l19].Value = "Yes"
ElseIf [e19].Value = "N/A" Then
[l19].Value = "N/A"
Else
For Each cell In Range("i18:i21, l18")
If cell.Value = "{a}" Then
[l19].Value = "{b}"
End If
Next
End If
End Sub
Here my example of thing that i will use.
On the left side is the patch it will use NAME BASE REVISE to check the version of package.
Can you convert the script here in to VBA code. I will study about it and integrate to my real work:
if (Patch name = Pack name) then **** searching for same Name on patch column to reference for patch base and revise number
if (base(c column) > base(h column)) ***checknumber[cellbycell]
display "yes" in J cell
or if (base(C column) = base(h column)) then
check if revise(D column) > revise(I column)
display "yes" in J cell
else display No
So if you can give me example code ; if you have sometime please explain to me that what each line of code is meaning.
You don't need vba for this
=IF($A2=$G2,IF($C2>$H2,"Yes",IF($C2=$H2,IF($D2>$I2,"Yes","No"),"No")),"No")
That goes in column J
something like this should work:
Option Explicit
Sub variousconditions()
Dim i As Integer, x As Integer
x = 0
For i = 2 To 10
With Excel.ThisWorkbook.ActiveSheet
If .Cells(i, 1) = .Cells(i, 7) Then '****searching for same Name on patch
Select Case .Cells(i, 3) '***checknumber[cellbycell]
Case Is > .Cells(i, 8)
.Cells(i, 10) = "yes"
Case Is = .Cells(i, 8)
If .Cells(i, 4) > .Cells(i, 9) Then
.Cells(i, 10) = "yes"
End If
End Select
End If
End With
Next i
End Sub
I have to re-iterate Siddharth's reference as that will tell you where you need to save this code etc. : http://msdn.microsoft.com/en-us/library/office/ee814737%28v=office.14%29.aspx
Here is a function to compare two dot-notation version numbers which you'd need to paste into a new module in the VBA editor.
Option Explicit
Public Function VersionCompare(CurrentVersion As Range, _
TargetVersion As Range)
Dim result As Integer
result = CompareDotStrings(CurrentVersion.Cells(1, 1).Value, _
TargetVersion.Cells(1, 1).Value)
If result = 1 Then
VersionCompare = True
Else
VersionCompare = False
End If
End Function
Private Function CompareDotStrings(LeftValue As String, _
RightValue As String) _
As Integer
Dim CompareLeft() As String, CompareRight() As String, CompareLength As Integer
CompareLeft = Split(LeftValue, ".")
CompareRight = Split(RightValue, ".")
CompareLength = UBound(CompareLeft)
If UBound(CompareRight) < CompareLength Then CompareLength = UBound(CompareRight)
Dim ElementLeft As Integer, ElementRight As Integer, Comparison As Integer
Dim ElementNumber As Integer
For ElementNumber = 0 To CompareLength
ElementLeft = CInt(CompareLeft(ElementNumber))
ElementRight = CInt(CompareRight(ElementNumber))
Comparison = ElementRight - ElementLeft
If Comparison <> 0 Then
CompareDotStrings = Sgn(Comparison)
Exit Function
End If
Next ElementNumber
CompareDotStrings = 0
End Function
With this you can use =VersionCompare(H2, C2) to compare two version numbers and everything else you want to do (like splitting apart the dashed versions) can be done with formulas in the worksheet.