I'm new in VBA and I am trying to do simply macro. I need my macro to work like this:
If there is a value in E5 cell, which is greater than 1, show a message box with text like "Your value is" /get value from E5/
I want to repeat this condition for all cells in column E.
First, I started with something that would work:
Sub test()
If Range("E5").Value > "1" Then
MsgBox "Your value is" (here I don't know how to import real value from E5)
End If
End Sub
And then I can click "Run" and the macro works ok (it means "formally ok", because this is not the target effect yet). But this macro only works when I click "Run" and I would like it to work always, even when I turn Excel off and turn it on again. Assigning a macro to an auto-shape is much easier, but here I fell :(
Note that "1" is a text/string and not a number. So if you want to compare a numeric value with > or < you need to write
If Range("E5").Value > 1 Then
or you don't get the result you want.
To get the value into your message box you need to concatenate it to your text using the & sign.
MsgBox "Your value is " & Range("E5").Value
To do this for all cells in Column E you need to loop
Dim LastRow As Long 'find last used row in E
LastRow = Cells(Rows.Count, "E").End(xlUp).Row
Dim iRow As Long
For iRow = 1 To LastRow
If Cells(iRow, "E").Value > 1 Then
MsgBox "Your value in Cell E" & iRow & " is " & Cells(iRow, "E").Value
End If
Next iRow
But note that if you have many values that are >1 in E then you will get many message boxes. If you only want to show the first message box that is >1 then put a Exit For right below MsgBow. This will then cancel the validation after the first invalid value was found and reported.
Related
I have tried a writing the code to set the limit of the textbox means if somebody enters the value 8 and if the limit in the code is set to the 10 then it should give message that pl. increase the entered value but adding to this its value of the limit also gets changed as per the value getting changed in the combo box means i have list of 5 to 7 numbers and there respective list if somebody selects the specific limit then the program should consider that adjacent cell value as respectively as shown in the image
For Eg: If someone selects the number 4456 then the minimum value of entering in the textbox is more than 50 same as if someone selects the 5566 number then minimum value entering in the textbox is more than 150 respectively if someone enters the value below that then it should show message that pl. increase the value with showing that minimum value requirement is 50 for 4456 eg.
Pl. help in getting solution of this
Any positive response are welcomed.
Pl. find the images of the userform and the sheet layout containing value in the attached document.
Private Sub ComboBox1_Change()
Dim t As Long, LastRow As Long, ws As Worksheet
Set ws = Sheets("Sheet1")
LastRow = ws.Range("H" & Rows.Count).End(xlUp).Row
For t = 2 To LastRow
If Val(Me.ComboBox1.Value) = ws.Cells(t, "H").Value Then
Me.TextBox1 = ws.Cells(t, "I").Value
If Val(Me.ComboBox1.Value) = ws.Cells(t, "H").Value Then
If Val(Me.TextBox2.Value) < ws.Cells(t, "J").Value Then
MsgBox ("Has to be greater than")
End If
End If
End If
Next t
End Sub
[User form Image the limit of value should be given to second textbox][1]
[Limits value ][2]
Regards,
Shubham Mehta
I think the best form here is to create a function which can save and return all of those number combinations. Like so:
Function CurrentMinimumValue() As Long
'Manually type in all the pairs of selected numbers and the corresponding minimum values
Select Case Me.ComboBox1.Value
Case 10
CurrentMinimumValue = 5
Case 20
CurrentMinimumValue = 15
Case 4456
CurrentMinimumValue = 50
Case 5566
CurrentMinimumValue = 150
End Select
End Function
Which can be used like:
Sub test()
Me.Combobox1.Value = 4456
MsgBox "The current minimum value allowed is " & CurrentMinimumValue()
MsgBox "Is the entered value above the minimum? " & Me.TextBox2.Value > CurrentMinimumValue()
End Sub
The line you were asking about can be rewritten like:
If Val(Me.TextBox2.Value) < CurrentMinimumValue() Then
MsgBox "Has to be greater than " & CurrentMinimumValue()
As per your example, assume the textbox is named TextBox2, then the following code allows you to check the value entered and issue a message:
Private Sub TextBox2_AfterUpdate()
If Me.Value < ComboBox1.Value Then
MsgBox "Value must be larger than " & ComboBox1.Value
Button_OK.Enabled = False
Else
Button_OK.Enabled = True
End If
End Sub
You must place this function in the code section of your user form.
I have a file which is modified through VBA.
It is concatenating three columns in the sheet to create a name.
However, another information needs to be concatenated to create the new data.
The data needs to be created by deducing something from data in another workbook.
In a scpecific column, with always the same name (but whose location can change, however in the sheet), the macro needs to look for a specific information. There can be four possibilities.
Once this possibility is identified, once the term is matched from either of these four, the VBA should increment the number in the end of the term in the workbook needs to be incremented.
The structure of is as follows in the first workbook:
Nip Nup Noupx
For "Noup" there are four cases : Noupx, Noupy, Noupu, Noupa
The VBA concatentes : NipNupNoupa
(or possibly NipNupNoupx, NipNupNoupu...)
Then the VBA should go in the other workbook, look for either the term "Noupa", "Noupu", "Noupx", "Noupy".
For each of these the specific number comming after "Noupa" (or the other) should be identified and should increment it by adding "+1".
Thus the result would be:
Noupa002 (resulting from the identification of Noupa001)
Noupu034 (resulting from the identificiation of Noupu033)
For the time being, I have the following VBA code, I do not know how to look for data in another workbook and increment it.
Sub TralaNome()
Const q = """"
' get source data table from sheet 1
With ThisWorkbook.Sheets(1).Cells(1, 1).CurrentRegion
' check if data exists
If .Rows.Count < 2 Or .Columns.Count < 2 Then
MsgBox "No data table"
Exit Sub
End If
' retrieve headers name and column numbers dictionary
Dim headers As Dictionary
Set headers = New Dictionary
Dim headCell
For Each headCell In .Rows(1).Cells
headers(headCell.Value) = headers.Count + 1
Next
' check mandatory headers
For Each headCell In Array(("Costumer", "ID", "Zone“, "Product Quali", "Spec A", "Spec B", "Spec_C", "Spec_D", "Spec_1", " Spec_2", " Spec_3", " Spec_4", " Spec_5", " Spec_6", " Spec_7", "Chiavetta", "Tipo_di _prodotto", "Unicorno_Cioccolato", “cacao tree“)
If Not headers.Exists(headCell) Then
MsgBox "Header '" & headCell & "' doesn't exists"
Exit Sub
End If
Next
Dim data
' retrieve table data
data = .Resize(.Rows.Count - 1).Offset(1).Value
End With
' process each row in table data
Dim result As Dictionary
Set result = New Dictionary
Dim i
For i = 1 To UBound(data, 1)
MsgBox "Empty row"
Exit For
result(result.Count) = _
q & "ID " & data(i, headers("ID ")) & _
q & " Tipo_di _prodotto " & data(i, headers("Tipo_di _prodotto")) & _
q & " cacao tree " & data(i, headers("Nupu")) & _
q
End Select
Next
' output result data to sheet 2
If result.Count = 0 Then
MsgBox "No result data for output"
Exit Sub
End If
With ThisWorkbook.Sheets(2)
.Cells.Delete
.Cells(1, 1).Resize(result.Count).Value = _
WorksheetFunction.Transpose(result.Items())
End With
MsgBox "Completed"
End Sub
The columns are grouped through this macro, but I need to now look in the other worksheet, increment the various Noupu, Noupy etc etc etc...
I think that a VBA of that sort should be used to add an incremented value :
Function GetLastRowWithData(WorksSheetNoupa As Worksheet, Optional NoupaLastCol As Long) As Long
Dim lCol, lRow, lMaxRow As Long
If NoupaLastCol = 0 Then
NoupaLastCol = wsSheet.Columns.Count
End If
lMaxRow = 0
For lCol = NoupaLastCol To 1 Step -1
lRow = wsSheet.Cells(wsSheet.Rows.Count, lCol).End(xlUp).Row
If lRow > lMaxRow Then
lMaxRow = lRow
End If
Next
GetLastRowWithData = lMaxRow
End Function
(sorry, this probably should be a comment but I don't have enough reputation as yet).
However even without checking through your code in detail, I'm seeing an exit for in the middle of a for loop without an If to avoid it in certain conditions. Presumably this means that whatever's written below that line in the loop, never gets done - nor is the loop any good for anything but the first instance. (it's the loop that's annotated 'process each row in table data)
Have you tried running this step by step? (go into the VBEditor with a test dataset open, and hit F8 or the 'step into' button in debug toolbar )
I am trying to create a VBA project like this, but I'm having a hard time using the LIKE function and nothing seems to happen when I hit the run button.
What I'm trying to do:
If the first digit is either a number or a blank cell in B4:B245, then enter a text in range D4:245.
If the last digit of the numeric is even in C4:C245, then enter a text in range D4:D245.
More info:
Product codes were imported
LEFT function was used to find the "First digit of product code"
RIGHT function was used to find the "Numeric digits of product code"
My current position in excel and VBA:
Sub number()
Dim first As Range
Set first = Range("B4:B259")
Dim numeric As Range
Set numeric = Range("C4:B259")
Dim DColumn As Range
Set DColumn = Range("D4:D259")
For Each first In DColumn
If first Like " " Then
DColumn = "Invalid Part Number"
DColumn.Interior.ColorIndex = 6
End If
Next
End Sub
The below macro will perform 3 tests & each will get it's own output.
Check for Numeric or blank first character
Check for Even ending character
Check for Odd ending character
These test are not in unison - the output will be one, or none. As soon as a test statement is TRUE, the loop will end for that cell and other values will not be tested.
For example, this macro will not provide you outputs when #1 & #2 from above are true. It will only tell you if #1 is true.
This code does not require you to split the product codes. The macro will work with them as is
Sub MyNum()
Dim xCell As Range, Product_Code As Range
Set Product_Code = Sheets("Sheet1").Range("A2:A9") '<-- Update sheet name
For Each xCell In Product_Code
If IsNumeric(Left(xCell, 1)) Or Left(xCell, 1) = " " Then
xCell.Offset(0, 1) = "Invalid Product: Char 1 = Numeric or Null"
ElseIf Right(xCell, Len(xCell) - 1) Mod 2 = 0 Then
xCell.Offset(0, 1) = "Even Ending Range"
ElseIf Right(xCell, Len(xCell) - 1) Mod 2 <> 0 Then
xCell.Offset(0, 1) = "Odd Ending Range"
End If
Next xCell
End Sub
I'm working on problem that necessitates the use of nested formulas in excel. For eg:
I have a column for errors and one for its analysis
Error Analysis
Enter a valid material number Invalid Material
Eg errors:
Enter a valid material number; The material number 1234 does not
exist.
PO number XYZ does not exist.
VIN number 123 does not exist.
Country of origin AB does not exist.
I have a compendium of such errors and their analyis in the next sheet, and I'm using VLOOKUP in conjuction with FIND to lookup the analysis for the known errors.
=VLOOKUP(LEFT(F2, FIND(" ", F2, FIND(" ", F2) + 1) - 1)&"*", 'Sheet2'!A:B, 2, 0)
What i'm trying to do here is extract the first two words from the error and append a * to it and use it in VLOOKUP.
It would be something like Vlookup "PO number *" in the other sheet and get the analysis for it. Asterisk is because I don 't get the same number daily. And I also know that the extracted first two words of the error will be unique. (I know that error with "Enter a" as the first two words will not appear again).
Now I get errors in the same column so I thought of making a button and writing a code which uses the above formula.
I tried to modify some code off the net, but I'm not getting anywhere with it. I'm totally new to VBA. It'd be great if you can provide a snippet for this. I'll try to replicate the procedure for other needs.
This code seems to be working for now
Sub PopulateAnalysis()
Dim an_row As Long
Dim an_clm As Long
Dim lft As String
Dim st_num As Integer
Dim fin As String
Dim searchStr As String
Dim soughtStr As String
Table1 = Sheet1.Range("F2:F6") 'ErrorColumn from Error table (How do I make the range dynamic??)
Table2 = Sheet5.Range("A1:B6")
an_row = Sheet1.Range("G2").Row ' Populate this column from the analysis table on sheet2
an_clm = Sheet1.Range("G2").Column
For Each cl In Table1
'How do I translate the above formula into VBA statements??
st_num = InStr(InStr(cl, " ") + 1, cl, " ")
lft = left(cl, st_num - 1)
fin = lft & "*"
Sheet1.Cells(an_row, an_clm) = Application.WorksheetFunction.VLookup(fin, Table2, 2, True)
an_row = an_row + 1
Next cl
MsgBox "Done"
End Sub
This should work. You don't need the debug lines of course ;)
Sub PopulateAnalysis()
Dim rngTableWithErrors As Range
Dim rngTableWithAnalysis As Range
Application.ScreenUpdating = False
'set the range for Table with error, Table1 on sheet 1
With Sheets(1) 'change to name of the sheet, more reliable than index num.
Set rngTableWithErrors = .Range("F2:F" & .Cells(.Rows.Count, 6).End(xlUp).Row)
Debug.Print rngTableWithErrors.Address
End With
'set the range for Table with Analysis, Table 2 on sheet 2
With Sheets(2) 'change to name of the sheet, more reliable than index num.
Set rngTableWithAnalysis = .Range("A1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
Debug.Print rngTableWithAnalysis.Address
End With
'formula for cell G2
'=VLOOKUP(LEFT(F2;FIND(" ";F2;FIND(" ";F2)+1)- 1)&"*";Sheet2!A1:B23;2; 0)
rngTableWithErrors.Offset(0, 1).FormulaR1C1 = _
"=VLOOKUP(LEFT(R[0]C[-1],FIND("" "",R[0]C[-1],FIND("" "",R[0]C[-1])+1)-1)& ""*"",Sheet2!R1C1:R" & rngTableWithAnalysis.Rows.Count & "C2,2, 0)"
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
Notes
You can notice, that we are setting the upper left cells of ranges manually. It's better practice to somehow find the upper left cells (using Find method is my favorite) and work from there. You never know, how the user will change the worksheet - i.e. add new rows, columns etc.
I want to code a program that compares two columns in two sheets. The user will input the sheet names and ranges he/she wants to compare. If data are found in both sheets the first sheet will highlight the cells in green indicating that the value is available in the other sheet.
When I run the code it gives a run time '9' error: subscript is out of range
Note: When I run the code by entering the sheet name in the code instead of using the text box, it runs the program successfully.
Private Sub FindBtn_Click()
MsgBox (fromSheetTxtBox) ' it outputs the sheet name
'MsgBox (fromRangeFromTxtBox)
'MsgBox (fromRangeToTxtBox)
'MsgBox (toSheetTxtBox)
'MsgBox (ToRangefromTxtBox)
'MsgBox (ToRangeToTxtBox)
'Dim toSheet As String
'Set toSheet = toSheetTxtBox.Value
Dim i As Integer
For i = 8 To 9331
Set cell = Worksheets(fromSheetTxtBox.Text).range("D8:D1427").Find(What:=Worksheets(toSheetTxtBox.Text).Cells(i, 2), lookat:=xlWhole)
If Not cell Is Nothing Then ' if jde cell value is found in tops then green jde cell
Worksheets("toSheetTxtBox").Cells(i, 2).Interior.ColorIndex = 4
End If
Application.StatusBar = "Progress: " & i & " of 9331 " '& Format(i / 9331, "%")
Next i
End Sub
If toSheetTxtBox is a TextBox, change this line:
Worksheets("toSheetTxtBox").Cells(i, 2).Interior.ColorIndex = 4
to this:
Worksheets(toSheetTxtBox).Cells(i, 2).Interior.ColorIndex = 4