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
Related
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.
I am trying to implement a find function in a userform in a textbox.
Once it detects that 4 digits have been input it looks for this value in a list of models in range ("C39:C102").
It returns the value of the cell that is two cells to the left of it (that's where the name of the group that the model number belongs to is stored), and changes the combobox to select that group automatically.
In the range ("C39:C102"), there are multiple model numbers per individual cell, as in:
C39= 9070, 4835, 2858, 2853
C40= 2374, 2737, 8857, 9895
etc.
The macro runs the first time after opening the Excel sheet but when I look for a second model number it goes to "not found".
Private Sub TextBox5_Change()
'when user inputs a model number automatically change the combo box below it to correct group
Dim rng1 As Range
Dim modelNum As String
If Len(TextBox5.Text) = 4 Then
modelNum = TextBox5.Value
Set rng1 = Range("C39:C102").Find(modelNum)
If Not rng1 Is Nothing Then
ComboBox1.Value = rng1.Offset(0, -2)
MsgBox "This tool (" & modelNum & ") belongs to " & rng1.Offset(0, -2) & " group."
Else
MsgBox modelNum & " not found"
End If
TextBox5.Value = ""
modelNum = ""
Set rng1 = Nothing
'ComboBox1.Value = ""
End If
End Sub
Your code works fine for me.
Instead of this:
Set rng1 = Range("C39:C102").Find(modelNum)
try being a bit more explicit:
Set rng1 = Range("C39:C102").Find(What:=modelNum, Lookin:=xlValue, LookAt:=xlWhole)
Find() settings in excel are "sticky" and unless you specify them explicitly you'll get whatever settings were last-used.
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
Hi i am trying to create a macro that will loop through my worksheet and find a specific string of text. Once if has found that string i want it to look to the column next to it and if it says PoweredOn or PoweredOff then add 1 to a counter then display the number at the end.
in my excel i have column A as my virtual machines and in column B is the power state I have a loop setup to look for one virtual machine that is a template and is powered on but when i run my macro it prints it as 0 here is my code at the moment.
Dim POT As Integer
Dim POFFT As Integer
Sheets("tabvInfo").Select
Range("A2").Select
Do
If ActiveCell.Value = ("vCloud Cell Template") Then
If ActiveCell.Offset(0, 1).Value = ("PoweredOn") Then
POT = Selection.Cell.Count
Else
If ActiveCell.Offset(0, 1).Value = ("PoweredOff") Then
POFFT = Selection.Cell.Count
End If
End If
End If
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(1, 0))
MsgBox ("The number of powerered on VMs is " & POT)
MsgBox ("The number of powerered off VMs is " & POFFT)
Can anyone tell me why i am getting 0 as the result? I also need to make this look at other templates on my system while retaining the count of values would i need to create a do loop for each template or can i use an array to do this?
Try this instead
Sub Main()
Dim POT As Long
Dim POFFT As Long
Dim c As Range
For Each c In Sheets("tabvInfo").Range("A2:A" & Sheets("tabvInfo").Range("A" & Rows.Count).End(xlUp).Row)
If StrComp(c, "vCloud Cell Template", vbTextCompare) = 0 Then
If StrComp(c.Offset(0, 1), "PoweredOn", vbTextCompare) = 0 Then
POT = POT + 1
ElseIf StrComp(c.Offset(0, 1), "PoweredOff", vbTextCompare) = 0 Then
POFFT = POFFT + 1
End If
End If
Next
MsgBox ("The number of powerered on VMs is " & POT)
MsgBox ("The number of powerered off VMs is " & POFFT)
End Sub
It eliminates the .Select statement and .ActiveCell. It's a simple for loop that achieves what you want.
I am not sure you realize but you can achieve this using 2 very simple formulas for PoweredOn and Off
=COUNTIFS(A:A,"vCloud Cell Template",B:B, "PoweredOn")
=COUNTIFS(A:A,"vCloud Cell Template",B:B, "PoweredOFF")
Therefore to eliminate the need for using a loop you can
Sub NoLoop()
MsgBox "Powered ON: " & Evaluate("=COUNTIFS(A:A,""vCloud Cell Template"",B:B, ""PoweredOn"")")
MsgBox "Powered OFF: " & Evaluate("=COUNTIFS(A:A,""vCloud Cell Template"",B:B, ""PoweredOff"")")
End Sub
I am getting an error I can't figure out:
After I run the macro below, two certain string values are pasted into the same two cells in ALL sheets, although I am sure that the sheets are not grouped or do not contain individual code of their own. Specifically, the items "B12" and "B25" are pasted on all pages at the same cells (A29 and A30) (See code). "B12" and "B25" have nothing to do with a cell location but are just identifiers unique to my application. They are values which are copied+pasted from one sheet into another. If it is a copy+paste error in the code, then I would expect all the items to have the same error because the "algorithm" subroutine is called for every sheet.
Sometimes, this also occurs without execution of the macro. And when I try to edit my workbook back to how it was before fields were pasted over (by clicking each cell and typing what used to be there), it still makes those changes to all sheets, even though I am sure they are not grouped or running code.
' Title: DSR AutoFill Macro
Sub autofill_DSR()
' Variable Declarations:
Dim x_count As Long
Dim n As Long
Dim item_a As String
Dim item_b As String
'Dim test_string As String
' Variable Initializations:
x_count = 0
Process_Control_NumRows = 15
Electrical_NumRows = 8
Environmental1_NumRows = 17
Env2_Regulatory_NumRows = 14
FIRE_NumRows = 15
Human_NumRows = 16
Industrial_Hygiene_NumRows = 16
Maintenance_Reliability_NumRows = 10
Pressure_Vacuum_NumRows = 16
Rotating_n_Mechanical_NumRows = 11
Facility_Siting_n_Security_NumRows = 10
Process_Safety_Documentation_NumRows = 3
Temperature_Reaction_Flow_NumRows = 18
Valve_Piping_NumRows = 22
Quality_NumRows = 10
Product_Stewardship_NumRows = 20
fourB_Items_NumRows = 28
'test_string = "NN"
' Main Data Transfer Code:
Sheets(Array("SUMMARY P.1", "SUMMARY P.2", "Process Control", _
"Electrical", "Environmental1", "Env.2 - Regulatory", "FIRE", _
"Human", "Industrial Hygiene", "Maintenance_Reliability", _
"Pressure_Vacuum", "Rotating & Mechanical", _
"Facility Siting & Security", "Process Safety Documentation", _
"Temperature-Reaction-Flow", "Valve-Piping", "Quality", _
"Product Stewardship", "4B ITEMS")).Select 'Create Array of all Sheets
'Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select ' For testing
' Process Control Sheet:
For n = 0 To (Process_Control_NumRows - 1) 'Cycle 16 times for each
'item row in process controls tab
Sheets("Process Control").Activate 'Choose specific sheet
Range("D15").Select 'Choose starting cell of "Yes" column
Call Module2.algorithm(n, x_count) 'Call on subroutine (see algorithm code)
Next n 'increment index to account for offset
' Electrical Sheet:
For n = 0 To (Electrical_NumRows - 1)
Sheets("Electrical").Activate
Range("D15").Select
Call Module2.algorithm(n, x_count)
If (x_count > 21) Then 'Abort autofill if too many items to hold
Sheets("SUMMARY P.1").Activate 'on both summary pages put together (21 count)
GoTo TooMany_Xs
End If
Next n
This continues for all the sheets...
' 4B ITEMS Sheet:
For n = 0 To (fourB_Items_NumRows - 1)
Sheets("4B ITEMS").Activate
Range("D16").Select ' NOTE: Starting cell is "D16"
Call Module2.algorithm(n, x_count)
If (x_count > 21) Then
Sheets("SUMMARY P.1").Activate
GoTo TooMany_Xs
End If
Next n
If (x_count > 5) Then 'Bring user back to last logged sheet
Sheets("SUMMARY P.2").Activate
Else
Sheets("SUMMARY P.1").Activate
End If
TooMany_Xs:
If Err.Number <> 0 Then
Msg = "you put more than 21 Items on the Summary Pages." & Chr(13) & _
"Consider editing your DSR or taking some other action."
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If
End Sub
And then this following macro is located in Module2:
Sub algorithm(n As Long, x_count As Long)
'If an "x" or "X" is marked in the "Yes" column,
'at descending cells down the column offset by the for loop index, n
If (ActiveCell.Offset(n, 0) = "x" Or ActiveCell.Offset(n, 0) = "X") Then
item_a = ActiveCell.Offset(n, -3).Value ' Store Letter value
item_a = Replace(item_a, "(", "") ' Get rid of "(", ")", and " " (space)
item_a = Replace(item_a, ")", "") ' characters that are grabbed
item_a = Replace(item_a, " ", "")
item_b = ActiveCell.Offset(n, -2).Value ' Store number value
item_b = Replace(item_b, "(", "") ' Get rid of "(", ")", and " " (space)
item_b = Replace(item_b, ")", "") ' characters that are grabbed
item_b = Replace(item_b, " ", "")
x_count = x_count + 1 ' increment the total x count
If (x_count > 5) Then ' If there are more than 5 "x" marks,
Sheets("SUMMARY P.2").Activate ' then continue to log in SUMMARY P.2
Range("A18").Select ' Choose "Item" column, first cell
ActiveCell.Offset((x_count - 6), 0).Value = (item_a & item_b)
'Insert cocatenated value of item_a and item_b
'(for example "A" & "1" = "A1")
'at the cells under the "Item" column, indexed by x_count
Else ' If there are less than 5 "x" marks,
Sheets("SUMMARY P.1").Activate ' log in SUMMARY P.1
Range("A25").Select
ActiveCell.Offset((x_count - 1), 0).Value = (item_a & item_b)
End If
End If
End Sub
By selecting all the sheets in your array, you are grouping them, and anything you write to a cell in any sheet will be written to all sheets.
This is the culprit:
Sheets(Array("SUMMARY P.1", "SUMMARY P.2", "Process Control", _
"Electrical", "Environmental1", "Env.2 - Regulatory", "FIRE", _
"Human", "Industrial Hygiene", "Maintenance_Reliability", _
"Pressure_Vacuum", "Rotating & Mechanical", _
"Facility Siting & Security", "Process Safety Documentation", _
"Temperature-Reaction-Flow", "Valve-Piping", "Quality", _
"Product Stewardship", "4B ITEMS")).Select
The fact that your issue occurs even if the code you posted hasn't been run makes me think there is something else going on after you've selected all the sheets.
Note that selecting and activating are a really bad idea. Declare variables for the objects you want to work with and interact with them that way instead of selecting them.
Here is a quick example of how you can loop through all the sheets in a workbook and modify them without selecting or activating. You can modify your code to use this pattern:
Sub LoopThroughAllSheets()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
For Each ws In wb.Sheets
ws.Range("D15").Value = ws.Name
Next ws
End Sub
Please read the following to get you started on writing cleaner, more efficient VBA code:
Beginning VBA: Select and Activate
Excel macro - Avoid using Select
Sheets(Array("SUMMARY P.1", "SUMMARY P.2", "Process Control", _
"Electrical", "Environmental1", "Env.2 - Regulatory", "FIRE", _
...
"Product Stewardship", "4B ITEMS")).Select
is grouping all these worksheets. At some point you need to Ungroup them by selecting a single worksheet:
Worksheets("Whatever").Select
You should also examine your code to check whether grouping the worksheets is actually necessary.