How do i apply this code to multiple cells? - excel

I made a code that lets me modify a specific cell's information from other cells as long as it's selected, but i needed to be able to select multiple cells.
i've tried multiplying the below code but with h4,h5,h6,etc instead of h3 and doesn't work. it instead completely disables the code, even the already functioning part and i have to restart excel.
With Selection
If Selection.Value = Range("h3") Then
Range("bk3").Value = True
Range("l3").Value = Now
If MsgBox("Do you want to sign?", vbYesNo, "Signature Confirmation") = vbYes Then '<---- Confirmation Pop-Up
VarNUMCB = InputBox("Type Collab. Number") '<---- Collab. Number Pop-Up.
Range("j3").Value = Range("j3").Value & " | " & VarNUMCB
Else
End If
Else
Range("bk3").Value = False
End If
End with
note: i don't want the changes to be made on l3,j3 and bk3 from any selected cell. each cell should be linked to its own line(horizontal) and selecting multiple cells from the H column should properly fill the rest of the linked information.

This is the answer i was able to pull through, it may not be the most effective but it does its job.
(i have to apply this to each line, pretty painful if there are dozens/hundreds of lines
If cel.Value = Range("H3") 0 Then 'What's up? nice, you found me. yeah it was the intern. so many "if" statements for no reason? i like the extra work :D
If Range("l3").Value = "" Then
Range("bk3").Value = True
Range("l3").Value = Now
If MsgBox("Do you want to sign?", vbYesNo, "Signature Confirmation") = vbYes Then '<---- Confirmation Pop-Up
VarNUMCB = InputBox("Place Collab. Number") '<---- Collab. Numb.Pop-Up
Else
End If
If Range("h3").Value <= 0 Then
Range("j3").Value = Range("j3").Value & " | " & VarNUMCB
Else
End If
Else
End If
Else
End If

Related

How can I create message boxes dependent upon entries in certain cells?

I am trying to check whether certain boxes are checked complete.
If any of the boxes are marked incomplete, prompt the user with a warning message.
If all are marked complete, move on to the next step in the overall macro.
Sub check_complete()
Dim x As Integer
For x = 10 To 19
If Cells(x, 16).Value = "Complete" Then
End If
If Cells(x, 16).Value = "Incomplete" Then
Result = MsgBox("We noticed that you have not uploaded all of the data. Would you still like to continue?", vbYesNo + vbExclamation, "Error: Incomplete Data")
If Result = vbYes Then
End If
Else
End If
If Cells(x, 16) <> "Complete" <> "Incomplete" Then
Result = MsgBox("We noticed an error in your checklist." & vbNewLine & "The checklist items should be marked as Complete/Incomplete." & vbNewLine & vbNewLine & "Would you like to continue anyway?" & vbNewLine & "(Doing so may create issues in finalizing your data)", vbYesNo + vbExclamation, "Error: Incomplete Data")
If Result = vbYes Then
End If
Else
End If
Next x
End Sub
The code refers to a group of cells that either contain the text "Complete" or "Incomplete".
As the user moves through the group of macros, the cells automatically change from Incomplete to Complete.
If they skip a step, I would like to warn them.
Edit: I tinkered around with the code and found the answer to my own question. I figured I would share in case anyone ever has this question in the future.
My newly corrected [working] code is as follows:
Sub check_complete()
Dim x As Integer
Dim y As Integer
Sheets("Updating Data").Select
x = 10
y = 19
On Error GoTo eh
Do While x < y
Cells(x, 16).Select
If Selection.Value = "Incomplete" Then
Err.Raise Error_INVALID_DATA, "Updating Data", "Data upload not complete"
End If
x = x + 1
Loop
Done:
Exit Sub
eh:
Result = MsgBox("We noticed that you have not uploaded all of the data. Would you still like to continue?", vbYesNo + vbExclamation, "Error: Incomplete Data")
If Result = vbYes Then
On Error Resume Next
Else:
End
End If
End Sub

Using a checkmark to add value to a cell

im trying to create a macro for adding text to a field
i want when i click the checkmark to add a specific text to a case
i have 8 checkbox each one will add a different text to the same case
right now my code look like this
Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = True Then
Range("A56").Value = "Test"
Else
Range("A56").Value = " "
End If
End Sub
the problem is if i check 2 checkmark it always replace the text and i want it to add the text not replace it. and also when i uncheck the checkmark it remove everything in the case
the reason why i need it is to save time not having to write them manualy each time
i am very new to excel coding i apreciated any help you guys can give me
thanks a lot for ur time
So the first part:
Range("A56").value = Range("A56").value & " Text"
The second part I'm assuming the real entries are more substantial than "Test" otherwise you might get some false positives, but this should work pretty well:
Private Sub CheckBox1_Click()
With Sheet1 'Change this to the proper sheet codename
If Me.CheckBox1.Value = True Then
.Cells(56, 1).Value = .Cells(56, 1).Value & " Testing"
Else
If InStr(1, .Cells(56, 1).Value, " Testing") Then
Dim splitarr As Variant
splitarr = Split(.Cells(56, 1).Value, " Testing")
Dim element As Variant
.Cells(56, 1).Value = ""
For Each element In splitarr
.Cells(56, 1).Value = .Cells(56, 1).Value & element
Next element
End If
End If
End With
End Sub
You might want to make the entered or deleted string a variable so it is easier to change.

Userform button not working when typing in a textbox vba

I have a userform where you have to enter data into textboxes and then press a button to put the data into the sheet. When I'm typing into the last textbox and I'm done, I click the button and it doesn't respond. Also, I have noticed that my cursor keeps blinking inside the last textbox so I guess there's a problem there (while focused not able to click a button)?
In total I have 4 textboxes, 3 of them use data validation after their value has been updated. The last one does not have data validation.
The weird thing is that, next to the "next button", I have a button to clear the fields and that one works just fine. Below an image from my userform with a little bit of explanation because it's in another language (Dutch). Can anyone help me? Thanks!
The code used for the "next" button is:
Note: the data gets validated not only when they updated the value of the textbox, but also an extra time when they click the next button.
Private Sub AddNextBtn_Click()
AddValueMod.AddDisplayOverview
End Sub
Sub AddDisplayOverview() 'This sub is in the "AddValueMod" module
'Check if information is valid via a function
If AddInformationValid("AccountSelector", True) And AddInformationValid("Date", True) And AddInformationValid("Amount", True) And AddInformationValid("Description", True) Then
'If valid, retrieve entered values
Dim account, dDate, amount, description As String
account = main.AddAccountSelector.Value
dDate = main.AddDateInput.Value
amount = main.AddValue.Value
description = main.AddDescription.Value
'Ask for sheet-writing-confirmation
overview = MsgBox("Kloppen volgende gegevens (kijk goed na!)?" & vbCrLf & vbCrLf & "Rekening: " & account & vbCrLf & "Datum: " & dDate & vbCrLf & "Bedrag: " & amount & vbCrLf & "Beschrijving: " & description & vbCrLf & "Vermeerdering/vermindering: Waarde wordt vermeerderd", vbYesNo + vbQuestion, "Kloppen volgende gegevens?")
If overview = vbYes Then
'Write data to sheet
AddValueMod.AddEnterDataIntoSheet
End If
End If
End Sub
And for the "clear fields" button:
Private Sub AddClearFieldsBtn_Click()
AddValueMod.AddClearFields (True)
End Sub
Sub AddClearFields(askForConfirmation As Boolean) 'This sub is in the "AddValueMod" module
grey = RGB(128, 128, 128)
'If askForConfirmation = True, ask for confirmation before clearing fields
If askForConfirmation = True Then
confirmationMessage = MsgBox("Bent u zeker dat u de velden wilt leegmaken?" + vbCrLf + "U zal terug opnieuw moeten beginnen.", vbYesNo + vbQuestion, "Velden leegmaken?")
If confirmationMessage = vbYes Then
'Clear fields
main.AddAccountSelector.Value = ""
main.AddDateInput.Value = ""
main.AddValue.Value = ""
main.AddDescription.Value = ""
End If
ElseIf askForConfirmation = False Then
'Clear fields
main.AddAccountSelector.Value = ""
main.AddDateInput.Value = ""
main.AddValue.Value = ""
main.AddDescription.Value = ""
End If
'Reset the textboxes' borders (they change if an input error occurred)
main.AddAccountSelectorError.Visible = False
main.AddAccountSelector.BorderStyle = fmBorderStyleSingle
main.AddAccountSelector.BorderColor = grey
main.AddDateInputError.Visible = False
main.AddDateInput.BorderStyle = fmBorderStyleSingle
main.AddDateInput.BorderColor = grey
main.AddValueError.Visible = False
main.AddValue.BorderStyle = fmBorderStyleSingle
main.AddValue.BorderColor = grey
main.AddDescriptionError.Visible = False
main.AddDescription.BorderStyle = fmBorderStyleSingle
main.AddDescription.BorderColor = grey
End Sub
P.S.: I've already tried a possible solution with IsCancel = True/False that I found online in this article. It's possible it didn't work because the article is not quite related to my problem but I felt like I should mention it :).
You did not provide all relevant code. AddInformationValid() and AddEnterDataIntoSheet are missing.
However, if the AddInformationValid() returns False on any item, the behaviour is just as you describe. In AddDisplayOverview() there will be no error message, the AddEnterDataIntoSheet sub will be bypassed and on return from the button handler the cursor remains flashing in the last entry field.
You need to verify and correct the AddInformationValid() Function.
I also strongly recommend to show an error message if the data validation fails.

If OptionButton is active TextBox is mandatory

In my UserForm I have several frames, several OptionButtons and several TextBoxes. one example you can see in the screenshot.
Now I want that if I check the medium or high risk OptionButton the TextBox ("- Comment Risk -") should be mandatory and if it is empty or nothin was added an error message should be shown.
This is my macro so far:
Sub Comment_Check()
'obMedium = OptionButton "Medium"
'obHigh = OptionButton "High"
'txtRisk = TextBox "- Comment Risk -"
With UserForm1
For x = 1 to 6
If .Controls("obMedium" & x).Value = True Or .Controls("obHigh" & x).Value = True _
And .Controls("txtRisk" & x).Value = "" Or .Controls("txtRisk" & x).Value = "- Comment Risk -" Then
.Controls("txtRisk" & x).BackColor = RGB(255, 75, 80)
MsgBox "Error Message"
End If
Next
End With
End Sub
Now my problem is, if I check Medium and write something in the risk TextBox, the TextBox will be colored red and the error message is shown. If I check High and write something to the TextBox everything works fine.
What do I have to change that both ways will work.
The main issue is that you have to use parenthesis to group your Or & And satements logically.
Furthermore I suggest the following changes:
Write - Comment Risk - and - Comment Chance - into a Label control above the TextBoxes instead of writing it into the TextBox itself. So the user always can see which is which even when filled with data. Also the code would be easier.
Use a switch ErrorOccured that you turn True in your loop, otherwise you will get 6 error messages in a row (worst case).
Use Option Explicit and declare all your variables properly.
Something like the following should work.
Option Explicit
Sub Comment_Check()
Dim ErrorOccured As Boolean
With UserForm1
Dim x As Long
For x = 1 to 6
If (.Controls("obMedium" & x).Value Or .Controls("obHigh" & x).Value) _
And .Controls("txtRisk" & x).Value = vbNullString Then
.Controls("txtRisk" & x).BackColor = RGB(255, 75, 80)
ErrorOccured = True
End If
Next x
End With
If ErrorOccured Then
MsgBox "Error Message"
End If
End Sub
If you want to turn them non-red in a second run (eg. if you re-check after the user corrected his edit) then add a
ElseIf (.Controls("obMedium" & x).Value Or .Controls("obHigh" & x).Value) And .Controls("txtRisk" & x).Value <> vbNullString Then
.Controls("txtRisk" & x).BackColor = RGB(50, 168, 82) 'green
'don't set ErrorOccured to False here!
right before the End If line otherwise the box will stay red even if the user corrected his edit.

EXCEL VBA WorksheetFunction.CountIf() in a SELECT CASE

I know that it is possible to use If statement but out of curiosity, as mentioned in the title, is it possible to use SELECT statement to do something as BOLDED below? I've submitted my whole Sub as below for better understanding:
Sub addNewCust_Click()
Dim response As String
response = Application.InputBox(prompt:="", Title:="New customer name", Type:=2)
Select Case response
Case False
Exit Sub
'Check if response is not an empty value AND record found in "CustomerList"
Case Is <> "" & WorksheetFunction.CountIf(Worksheets("CustomerList").Range("B:B"), response) > 0
MsgBox "'" & response & "' already exists on this sheet."
Call addNewCust_Click
'Check if response is not an empty value and record is not found in "Customerlist"
Case Is <> "" & WorksheetFunction.CountIf(Worksheets("CustomerList").Range("B:B"), response) < 1
Sheets("CustomerList").Range("B1048576").End(xlUp).Offset(1, 0).Value = response
MsgBox "'" & response & "' successfully entered!"**
Case Else
MsgBox "Field is empty!"
Call addNewCust_Click
End Select
End Sub
Like this?
Sub addNewCust_Click()
Dim response As String
response = Application.InputBox(prompt:="", Title:="New customer name", Type:=2)
Select Case response
Case False: Exit Sub
'Check if response is not an empty value AND record found in "CustomerList"
Case Is <> ""
If WorksheetFunction.CountIf(Worksheets("CustomerList").Range("B:B"), response) > 0 Then
MsgBox "'" & response & "' already exists on this sheet."
Call addNewCust_Click
Else
Sheets("CustomerList").Range("B1048576").End(xlUp).Offset(1, 0).Value = response
MsgBox "'" & response & "' successfully entered!"
End If
Case Else
MsgBox "Field is empty!"
Call addNewCust_Click
End Select
End Sub
FOLLOWUP (From Comments)
Select Case is considered to be faster than If-Endif but for such a small scenario, the efficiency comparison is futile. What is more important is how you write the code
Below is another way. I love this way as things are broken down into smaller parts and everything is declared properly. I am not touching error handling below. See this for detailed analysis.
The below method is useful because
when you are looking at your code (say maybe after an year) and you know exactly what is happening since the code is commented.
Easy to maintain the code. For example if the Sheet name changes then you have to change it only at one place. The alternative is to also use Codenames
You can use the same code across all Excel platforms. If you hardcode your range, Ex: Range("B1048576") then the above code will not work in Excel 2003.
Sample Code
Sub addNewCust_Click()
Dim ws As Worksheet
Dim Lrow As Long
Dim response
'~~> Set the relevant worksheet
Set ws = ThisWorkbook.Worksheets("CustomerList")
With ws
Do
'~~> Get user response
response = Application.InputBox(prompt:="", Title:="New customer name", Type:=2)
Select Case response
Case False: Exit Sub '<~~ If user presses cancel or closes using 'X'
Case "": MsgBox "Field is empty!" '<~~ If user enters a blank entry
Case Else
'~~> Check if the entry exists
If WorksheetFunction.CountIf(.Range("B:B"), response) > 0 Then
MsgBox "'" & response & "' already exists on this sheet."
Else
'~~> Get last Row
Lrow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
'~~> Add the new entry
.Range("B" & Lrow).Value = response
MsgBox "'" & response & "' successfully entered!"
Exit Do 'OR Exit Sub (As Applicable)
End If
End Select
Loop
End With
End Sub

Resources