I have a very simple code and my is problem is that I want to return a string in different circumstances based on ElseIf but somehow it does not work at all.
If the score is 6 in cell A1 then, the code should return specific text in the cell next to ("Excellent") etc. The code does not want to return the text at all. Can somebody tell me why?
Sub ElseIf_ex()
Dim score As Integer, score_comment As String
note = Range("A1").Value
score_comment = Range("B1").Value
If note = 6 Then
score_comment = "Excellent"
ElseIf note = 5 Then
score_comment = " Good"
ElseIf note = 4 Then
score_comment = "Satisfactory"
Else
score_comment = "Zero"
End If
End Sub
You will have to assign score_comment back to some cell, otherwise your code might work, but not output anything. You missed to add something like
Range("B1").Value=score_comment
just before the End Sub line.
Related
I am comparing the splitted Source_Doc_No_P of PER MAP to PER SAWT then if it matched it will color the BackColor of DataGridview into yellow but there is something wrong in my code when the split value of Source_Doc_No_P is inside the If condition it only get 1 value of splitted string. Please see the screen-shot and code to help you understand my problem.
For x As Integer = 0 To Me.DataGridView4.Rows.Count - 1
Dim sdoc_map As String = DataGridView4.Rows(x).Cells("Source_Doc_No_P").Value.ToString
Dim split_sdoc() As String = sdoc_map.Split("/")
For Each part As String In split_sdoc
'Output of split_doc after For each loop
'BS091
'BS092
'BS093
If part = Me.DataGridView4.Rows(x).Cells("Source_Doc_No").Value.ToString Then
'Output of split_doc after If condition
'BS091
'It should be
'BS091
'BS092
'BS093A
'-------Will automatically color the yellow of mathced Source Document----------'
Me.DataGridView4.Rows(x).Cells(0).Style.BackColor = Color.Yellow
Me.DataGridView4.Rows(x).Cells("Source_Doc_No").Style.BackColor = Color.Yellow
Me.DataGridView4.Rows(x).Cells("ATC").Style.BackColor = Color.Yellow
Me.DataGridView4.Rows(x).Cells("Prepaid_Tax").Style.BackColor = Yellow
Me.DataGridView4.Rows(x).Cells("Source_Doc_No_P").Style.BackColor = Color.Yellow
Me.DataGridView4.Rows(x).Cells("ATC_P").Style.BackColor = Color.Yellow
Me.DataGridView4.Rows(x).Cells("Tax_Withheld_P").Style.BackColor = Color.Yellow
'-----------------------------------End---------------------------------------'
End If
Next
Next
Current Result
What should be the result
Dim sdoc_map As String = DataGridView4.Rows(x).Cells("Source_Doc_No_P").Value.ToString
check Here.. I think just Confused With Cell Name . because Cells("Source_Doc_No_P") not Present here. Check the cell Name and then Proceed.
I have been looking on stackoverflow but could not get an definitive answer to my little problem. I am fairly new to coding and am still dealing with syntax sometimes.
Right now I have a little loop reading an array, inside the loop it checks for an if statement. I have been checking the loop which works fine, and the array as well. The if statement works until im starting to use "isText".
After searching a bit I noticed "isText" is not a function, is there something equivalent?
Right now my if statement goes as follows: IF A = B and C (Contains ANY value at all) then Write something somewhere in a cell
Right now the code I am using is:
Sub KnopKlik()
Dim Soorten(10)
Dim Teller As Integer
Dim Column1 As String
Column1 = Sheets(2).Range("C1").Value
MsgBox (Column1)
Sheets(1).Select
Range("E2").Select
For Teller = 0 To 10
Soorten(Teller) = ActiveCell.Offset(Teller).Value
Next Teller
For Teller = 0 To 10
If Sheets(2).Range("B9") = Soorten(Teller) And Application.IsText(Column1) Then
MsgBox ("Check")
Sheets(2).Range("E9").Value = ActiveCell.Offset(Teller, 3)
Sheets(2).Select
Range("B9").Select
Teller = 10
Else
End If
Next Teller
End Sub
Right now the last part of the if statement is the problem
And Application.IsText(Column1) Then
EDIT**
This is how I solved it now. Basically whenever there is ANYTHING at all in that cell it will pass through.
If Sheets(2).Range("B9") = Soorten(Teller) Then
'Als B9 Gelijk is aan (database) DAN!>>>
If Not Column1 = "" Then
Sheets(2).Range("E9").Value = ActiveCell.Offset(Teller, 3)
End If
Else
End If
Thanks in advance.
You can do it like this:
If Sheets(2).Range("B9") = Soorten(Teller) And Len(Trim(Column1)) > 0 Then
The len will return the length of the string. The Trim will remove the empty spaces from left and right, thus if it is an empty string it will be true.
I need to validate user input on when cells change and show the error in another cell in Excel using VBA.
I run into problems where my validator is called on all cells in the sheet when a user inserts rows or column which makes Excel unresponsive for a long time, how can I fix this?
Below are my requirements and my current solution with full documentation.
Definition and requirements
Consider the following table:
Example User Input Table
| | | Tolerance | | |
| Type | Length | enabled | Tolerance | Note |
|------|--------|-----------|-----------|----------------------------|
| | 4 | 0 | | Type is missing |
| | | 0 | | Type is missing |
| C | 40 | 1 | 110 | |
| D | 50 | 1 | | Tolerance is missing |
| | | | | |
The idea is that the user inputs values in the table, once a value has been changed (the user leaves the cell) the value is validated and if there is a problem the error is printed in the Note column.
Blank lines should be ignored.
I need this to be robust meaning it should not fail on any user input, that means it has to work for the following cases:
Paste values
Delete rows
Insert rows (empty or cut cells)
Insert/delete columns *
Any other case I missed thinking about?
*It is OK if the the validation fails when a user is deleting a column that is part of the table as this is seen as the user willfully vandalizing the sheet, but it has to fail gracefully (i.e. not by validating all cells in the worksheet which takes a long time). It would have been great if this action was undoable, however my current understanding of Excel suggests this is impossible (after a macro has changed something in the sheet, nothing can be undone anymore).
The Note cell can only contain one error at a time, for the user the most relevant error is the one for the cell the user last changed, so it should display this error first. After the user fixes that error the order is not that important anymore, so it could just display the errors from left to right.
Problems with current approach
My problem is that when rows/columns are inserted validation is triggered for all cells in the sheet which is a very slow process and to the user it looks like the program has crashed, but it will return once the validation is complete.
I don't know why Excel does this but I need a way to work around it.
Code placed in a Sheet named 'User Input'
My solution is based on the only on change event handler I know of: the per sheet global Worksheet_Change function (ugh!).
Worksheet_Change function
First it checks if the changed cell(s) intersects with the cells I'm interested in validating. This check is actually quite fast.
OldRowCount here is a try to catch the user inserting or deleting cells depending on how the used range changes, however this only solves some cases and introduces problems whenever Excel forgets the global variable (which happens now and then for as to me unknown reasons) as well as the first time the function is run.
The for loop makes it work for pasted values.
Option Explicit
Public OldRowCount As Long
' Run every time something is changed in the User Input sheet, it then filters on actions in the table
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRowCount As Long
NewRowCount = ActiveSheet.UsedRange.Rows.count
If OldRowCount = NewRowCount Then
If Not Intersect(Target, Me.Range(COL_TYPE & ":" & COL_TOLERANCE)) Is Nothing Then
Dim myCell As Range
' This loop makes it work if multiple cells are changed, for example while pasting cells
For Each myCell In Target.Cells
' Protect the header rows
If myCell.row >= ROW_FIRST Then
checkInput_cell myCell.row, myCell.Column, Me
End If
Next
End If
ElseIf OldRowCount > NewRowCount Then
'Row deleted, won't have to deal with this as it solves itself
OldRowCount = NewRowCount
ElseIf OldRowCount < NewRowCount Then
Debug.Print "Row added, TODO: deal with this"
OldRowCount = NewRowCount
End If
End Sub
Code placed in a module
Global variables
Defines the rows/columns to be validated.
Option Explicit
' User input sheet set up
Public Const ROW_FIRST = 8
Public Const COL_TYPE = "B"
Public Const COL_LENGTH = "C"
Public Const COL_TOLERANCE_ENABLED = "D"
Public Const COL_TOLERANCE = "E"
Public Const COL_NOTE = "G"
Cell checking function
This function validates the given cell unless the row where the cell is is empty.
Meaning we are only interested in validating cells on rows where the user has actually started giving values. Blank rows is not a problem.
It first validates the currently changed cell, if it is OK it will then validate the other cells on the given row (since some cells validation depends the values of other cells, see Tolerance enabled in my example table above).
The note will only ever contain one error message at a time, the above is done so that we always get the error of the last changed cell in the Note cell.
Yes, this will make the checker run twice on the current cell, while it is not a problem it could be avoided by a more complex if statement, but for simplicity I skipped it.
Sub checkInput_cell(thisRow As Long, thisCol As Long, sheet As Worksheet)
Dim note As String
note = ""
With sheet
' Ignore blank lines
If .Range(COL_TYPE & thisRow).value <> "" _
Or .Range(COL_LENGTH & thisRow).value <> "" _
Or .Range(COL_TOLERANCE_ENABLED & thisRow).value <> "" _
Or .Range(COL_TOLERANCE & thisRow).value <> "" _
Then
' First check the column the user changed
If col2Let(thisCol) = COL_TYPE Then
note = check_type(thisRow, sheet)
ElseIf col2Let(thisCol) = COL_LENGTH Then
note = check_length(thisRow, sheet)
ElseIf col2Let(thisCol) = COL_TOLERANCE_ENABLED Then
note = check_tolerance_enabled(thisRow, sheet)
ElseIf col2Let(thisCol) = COL_TOLERANCE Then
note = check_tolerance(thisRow, sheet)
End If
' If that did not result in an error, check the others
If note = "" Then note = check_type(thisRow, sheet)
If note = "" Then note = check_length(thisRow, sheet)
If note = "" Then note = check_tolerance_enabled(thisRow, sheet)
If note = "" Then note = check_tolerance(thisRow, sheet)
End If
' Set note string (done outside the if blank lines checker so that it will reset the note to nothing on blank lines)
' only change it actually set it if it has changed (optimization)
If Not .Range(COL_NOTE & thisRow).value = note Then
.Range(COL_NOTE & thisRow).value = note
End If
End With
End Sub
Validators for individual columns
These functions takes a row and validate the a certain column according to it's special requirements. Returns a string if the validation fails.
' Makes sure that type is :
' Unique in its column
' Not empty
Function check_type(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
Dim duplicate_found As Boolean
Dim lastRow As Long
Dim i As Long
duplicate_found = False
value = sheet.Range(COL_TYPE & affectedRow).value
check_type = ""
' Empty value check
If value = "" Then
check_type = "Type is missing"
Else
' Check for uniqueness
lastRow = sheet.Range(COL_TYPE & sheet.Rows.count).End(xlUp).row
If lastRow > ROW_FIRST Then
For i = ROW_FIRST To lastRow
If Not i = affectedRow And sheet.Range(COL_TYPE & i).value = value Then
duplicate_found = True
End If
Next
End If
If duplicate_found Then
check_type = "Type has to be unique"
Else
' OK
End If
End If
End Function
' Makes sure that length is a whole number larger than -1
Function check_length(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
value = sheet.Range(COL_LENGTH & affectedRow).value
check_length = ""
If value = "" Then
check_length = "Length is missing"
ElseIf IsNumeric(value) Then
If Not Int(value) = value Then
check_length = "Length cannot be decimal"
ElseIf value < 0 Then
check_length = "Length is below 0"
ElseIf InStr(1, value, ".") > 0 Then
check_length = "Length contains a dot"
Else
' OK
End If
ElseIf Not IsNumeric(value) Then
check_length = "Length is not a number"
End If
End Function
' Makes sure that tolerance enabled is either 1 or 0:
Function check_tolerance_enabled(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
value = sheet.Range(COL_TOLERANCE_ENABLED & affectedRow).value
check_tolerance_enabled = ""
If Not value = "0" And Not value = "1" Then
check_tolerance_enabled = "Tolerance enabled has to be 1 or 0"
Else
' OK
End If
End Function
' Makes sure that tolerance is a whole number larger than -1
' But only checks tolerance if it is enabled in the tolerance enabled column
Function check_tolerance(affectedRow As Long, sheet As Worksheet) As String
Dim value As String
value = sheet.Range(COL_TOLERANCE & affectedRow).value
check_tolerance = ""
If value = "" Then
If sheet.Range(COL_TOLERANCE_ENABLED & affectedRow).value = 1 Then
check_tolerance = "Tolerance is missing"
End If
ElseIf IsNumeric(value) Then
If Not Int(value) = value Then
check_tolerance = "Tolerance cannot be decimal"
ElseIf value < 0 Then
check_tolerance = "Tolerance is below 0"
ElseIf InStr(1, value, ".") > 0 Then
check_tolerance = "Tolerance contains a dot"
Else
' OK
End If
ElseIf Not IsNumeric(value) Then
check_tolerance = "Tolerance is not a number"
End If
End Function
Addressing support functions
These functions translates a letter to a column and vice versa.
Function let2Col(colStr As String) As Long
let2Col = Range(colStr & 1).Column
End Function
Function col2Let(iCol As Long) As String
Dim iAlpha As Long
Dim iRemainder As Long
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
col2Let = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
col2Let = col2Let & Chr(iRemainder + 64)
End If
End Function
Code is tested on/has to work for Excel 2010 and onwards.
Edited for clarity
Finally got it working
After quite a bit of more agonizing, it turned out the fix was quite easy.
I added a new test that checks if the area that the user changed (the Target Range) consists of a column by looking at the address of the Range, if it is a full column the checker will ignore it. This solves the problem where the validation hogs Excel for about one minute.
The result of the intersection calculation is used for the inner loop which limits checks to cells within the area we are interested in validating.
Fixed Worksheet_Change function
Option Explicit
' Run every time something is changed in the User Input sheet
Private Sub Worksheet_Change(ByVal Target As Range)
Dim InterestingRange As Range
Set InterestingRange = Intersect(Target, Me.Range(COL_TYPE & ":" & COL_TOLERANCE))
If Not InterestingRange Is Nothing Then
' Guard against validating every cell in an inserted column
If Not RangeAddressRepresentsColumn(InterestingRange.address) Then
Dim myCell As Range
' This loop makes it work if multiple cells are changed,
' for example when pasting cells
For Each myCell In InterestingRange.Cells
' Protect the header rows
If myCell.row >= ROW_FIRST Then
checkInput_cell myCell.row, myCell.Column, Me
End If
Next
End If
End If
End Sub
New support function
' Takes an address string as input and determines if it represents a full column
' A full column is on the form $A:$A for single or $A:$C for multiple columns
' The unique characteristic of a column address is that it has always two
' dollar signs and one colon
Public Function RangeAddressRepresentsColumn(address As String) As Integer
Dim dollarSignCount As Integer
Dim hasColon As Boolean
Dim Counter As Integer
hasColon = False
dollarSignCount = 0
' Loop through each character in the string
For Counter = 1 To Len(address)
If Mid(address, Counter, 1) = "$" Then
dollarSignCount = dollarSignCount + 1
ElseIf Mid(address, Counter, 1) = ":" Then
hasColon = True
End If
Next
If hasColon And dollarSignCount = 2 Then
RangeAddressRepresentsColumn = True
Else
RangeAddressRepresentsColumn = False
End If
End Function
well my idea is to refer the alphabet in cell J9 of the first worksheet called Table1 and to automatically color the shape called "Test" on the active worksheet. So basically if the alphabet entered is "a" in the cell J9 on the first worksheet, the shape "Test" on worksheet 2 should give out color 1, and if "b", color 2 and so on. I have written a code for it but sadly I keep receiving Error 424 Object Required. Any help would be deeply appreciated! Thanks!
Sub test()
If Table1.Range("J9") = "a" Then
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 1
ElseIf Table1.Range("J9") = "b" Then
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 2
ElseIf Table1.Range("J9") = "c" Then
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 3
ElseIf Table1.Range("J9") = "d" Then
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 4
Else
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 5
Does changing all Table1 references to Worksheets("Table1") fix it? For example:
If Worksheets("Table1").Range("J9") = "a" Then
ActiveSheet.Shapes("Test").Fill.ForeColor.SchemeColor = 1
It looks like is not with the shape code but with the Table1. Tables use a special structured addressing system (see Select, get and set data in Table). If you just want the value from cell J9 then this should do.
With Sheets("Table 1")
Select Case LCase(.Range("J9").Value)
Case "a"
.Shapes("Test").Fill.ForeColor.SchemeColor = 1
Case "b"
.Shapes("Test").Fill.ForeColor.SchemeColor = 2
Case "c"
.Shapes("Test").Fill.ForeColor.SchemeColor = 3
Case Else
' do nothing
End Select
End With
If a simple reference to J9 is insufficient, you will have to provide more information on the exact nature of Table1.
EDIT:
You may not be referencing the shape's name correctly. This code will enumerate all of hte shapes on the Table 1 worksheet and return their names to the VBE's Immediate window (in the VBE as Ctrl+G).
Dim i As Long
With Sheets("Table 1")
For i = 1 To .Shapes.Count
Debug.Print .Shapes(i).Name
Next i
End With
Is Test there as one of the names? can you determine the name of the shape you want to change?
#Jeeped Is it the same if I were to use apple, orange and lemon instead of alphabets? I changed my code to make it similar like yours. This time there is no error message but nothing happens
Sub test()
With ActiveSheet
Select Case LCase(.Range("J9").Value)
Case "apple"
.Shapes("Test").Fill.ForeColor.SchemeColor = 1
Case "orange"
.Shapes("Test").Fill.ForeColor.SchemeColor = 2
Case "lemon"
.Shapes("Test").Fill.ForeColor.SchemeColor = 3
Case Else
' do nothing
End Select
End With
End Sub
Is there anything wrong in this code? and by the way, what is LCase??
Sub SO()
ActiveSheet.Shapes("Test").Fill.FillColor.SchemeColor = Asc(UCase(Sheets("Table 1").Range("J9"))) - 64
End Sub
I have a really long IF AND OR formula that I'm trying to convert to VBA so it's quicker.
=IF(OR(H10<>"GL402",H10<>"GL412",H10<>"GL422",H10<>"GL432",H10<>"GL442",H10<>"GL452",H10<>"GL492",
H10<>"GL480",H10<>"GL370",H10<>"GL380",H10<>"GL710")*AND(OR(D10<>3,D10<>9,D10<>10),E10<>"ASX",
F10<>"AUD"),"F126",(IF(OR(H2="GL402",H2="GL412",H2="GL422",H2="GL432",H2="GL442",H2="GL452",H2="GL492")*
AND(OR(D2<>"3",D2<>"9",D2<>"10"),E2="ASX",F2="AUD"),"D111",.......))
I thought this should look like:
IF range("H10").Value <>""GL402"" or ""GL412"" or ""GL422"" or ""GL432"" or ""GL442"" _
or ""GL452"" or ""GL492"" or ""GL480"" or ""GL370"" or ""GL380"" or ""GL710"" AND _
range("D10").Value <>3 or 9 or 10 and range("E10").Value <>""ASX"" and _
range("F10").Value <>""AUD""
then
range("I10").Value = ""F126""
elseif
Range("H2").Value = ""GL402"" Or ""GL412"" Or ""GL422"" Or ""GL432"" Or ""GL442"" Or ""GL452"" Or ""GL492"" _
And Range("D2").Value <> 3 Or 9 Or 10 And Range("E2").Value = ""ASX"" And Range("F2").Value = ""AUD""
then
Range("I2").Value = ""D111""
elseif
another lengthy conditions with ANDs and ORs
plus I was hoping to loop this so it applies this whole IF formula until the value of cell A (whichever row) is blank.
I sort of know the loop should be
Do .........
next (with something like A1 + 1)
until A1 + 1 = ""
loop
any help appreciated!
The first rule of good code is that it should be clear - easy to read and debug. Only afterwards do you try to make it "fast". Converting your current expression to VBA may give a speed advantage but you still don't meet the first test...
You can make things cleaner with an expression like this (you can put this right in your spreadsheet):
=ISERROR(MATCH(H10,{"GL402","GL412","GL422","GL432","GL442","GL452","GL492","GL480","GL370","GL380","GL710"},0))
This will evaluate to "true" if the the value in H10 does not match any of the values in the array.
When you have a lot of or conditions in parallel, you can basically stop when the first condition is true.
An expression like that can be written in VBA as follows:
Sub test()
Dim matchStrings
Dim match1, match2
matchStrings = Array("GL402", "GL412", "GL422", "GL432", "GL442", "GL452", "GL492", "GL480", "GL370", "GL380", "GL710")
firstPart = Application.Match(Range("H10"), matchStrings, 0)
If IsError(firstPart) Then
MsgBox "no match found"
Else
match1 = true
MsgBox "match found at index " & firstPart
End If
End Sub
You can repeat similar code with other expressions, building match2, match3, etc - then combining with all the And and Or that you would like - for example
If match1 And (match2 Or match3) Then
... do something
Else
... do something else
End If
This won't work as expected:
If x = 1 Or 2 Or 3 Then
MsgBox "x is either 1, 2, or 3"
End If
because 2 and 3 aren't boolean (true/false) conditions (at least not the way you expect them to be).
The proper syntax is:
If x = 1 Or x = 2 Or x = 3 Then
MsgBox "x is either 1, 2, or 3"
End If
This is only a partial answer that nevertheless does address one of the many issues in your code.