Using a checkmark to add value to a cell - excel

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.

Related

Cannot access range item of For Each loop in UserForm VBA

So I have a UserForm that is triggered with the entry of a string in an InputBox. The user the selected from the list of populated ListBox items and presses a command button. This is supposed to redirect to the corresponding sheet in my workbook that contains the selection. To achieve this, I have to loop through the cells in a range defined in the For Each loop. I have done something similar many times before, with nearly identical loops, but for whatever reason, cell in the code below is Empty when I run the code, so I get error when I get to here: rosterSh.Rows(stuAddr & ":" & stuAddr).Select What's going on?
Private Sub OK_Click()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
' Set sheet to current sheet
Dim rosterSh As Worksheet, rosterShName As String
Dim stuCount As Integer, lastStuRow As Integer
Dim selectedStu As String, stuAddr As String
If ListBox1.ListIndex < 0 Then
MsgBox "You did not make a selection. Please make a selection or press " & Chr(34) & "Cancel" & Chr(34) & " to continue.", vbExclamation, "Alert"
Exit Sub
Else
selectedStu = ListBox1.List(ListBox1.ListIndex)
rosterShName = Replace(Split(selectedStu, "[")(1), "]", "") & " Roster"
Set rosterSh = ThisWorkbook.Sheets(rosterShName)
rosterSh.Activate
' Find selection on sheet, activate sheet and highlight student
stuCount = rosterSh.Cells(Rows.Count, "A").End(xlUp).row - 1
lastStuRow = stuCount + 1
Dim cell As Variant
For Each cell In rosterSh.Range("A2:A" & lastStuRow)
If InStr(cell.Value, Trim(Left(selectedStu, InStr(selectedStu, "[")))) > 0 Then
Debug.Print "cell is: " & cell
stuAddr = Split(cell.Address, "$")(1)
End If
Next cell
rosterSh.Rows(stuAddr & ":" & stuAddr).Select
End If
Call unloadUserForm9
UserForm9.Hide
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
EDIT: apologies for not being more clear about the error. I get a Run-time error '13': Type mismatch, which doesn't happen with nearly identical loops I have used.

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.

Add Comment on top of existing comment (sendkeys behaviour)

I have a macro that simply enters a comment in a cell. Linked with a hotkey as we use a lot of comments in a specific group file.
The expected outcome:
add a comment, enter date
if there already is a comment in the cell - add a new comment above (also with date)
Issue:
The macro below does everything right, except the sendkeys at the very end. If I enter manually the combination: Ctrl+Home, then End I get exectly where I want in the added comment.
On a comment that writes above the existing comment, I want to be exactly at the end of the date on the top line. As of now, everything works fine, except the curser still end at the bottom
Question:
How do I get the vba inside a comment to behave like keys Ctrl+Home, then End
(tldr: Sendkeys in code does not work inside a comment)
Option Explicit
Sub RPF_Comment()
Dim datum As String, old As String
datum = Format(Now, "dd.mm.yyyy") & ": "
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
On Error GoTo Commentexists
ActiveCell.AddComment ("")
ActiveCell.Comment.Visible = True
ActiveCell.Comment.Shape.Select
With Selection
.Font.Name = "Arial"
.Font.Size = 8
.Font.FontStyle = "Regular"
.Text = datum
End With
Exit Sub
Commentexists:
On Error GoTo out
ActiveCell.Comment.Visible = True
ActiveCell.Comment.Shape.Select
old = Selection.Text
With Selection
.Font.Name = "Arial"
.Font.Size = 8
.Font.FontStyle = "Regular"
.Text = datum & Chr(10) & Chr(10) & old
End With
SendKeys "^{HOME}"
SendKeys "{End}"
out:
End Sub
PS: I know ".select" is not nice. but on a sub this long, 1 select is ok :)

Parsing file names to excel vba

I am trying to isolate the address changes I have gotten from a folder containing a series of files with names containing the address changes. See the first image I included as an example of the folder I am drawing from. I iterate through the folder and output the to an excel sheet the original address and the new address to excel. The issue I am encountering is that not all file names are the same so I currently cannot draw the correct address change information from the filenames. The second photo included is a photo of the output, the files in yellow are the filenames that my script cannot iterate for. If anyone has any suggests on how to broaden the number of cases I can deal with it would be very helpful see current code below.
Dim AddChng As Worksheet
If sheetExists("AddressChange") Then 'create a new sheet if one doesn't exist
Set AddChng = ThisWorkbook.Sheets("AddressChange")
Else
Set AddChng = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
AddChng.Name = "AddressChange"
End If
AddChng.UsedRange.Delete shift:=xlUp 'clear the sheet
AddChng.Range("A1").Value = "Old Name" 'set up
AddChng.Range("B1").Value = "New Name"
AddChng.Activate
AddChng.Range("A2").Select
Dim StrFile As String
'Change this to the directory containing all Address Change Circulation emails
'This will Pull in a list and, to the best of its ability make two columns that hold the data for
'the old and the new address
StrFile = Dir(Range("AddressChangeFolderPath").Value)
Dim Names() As String
Dim StrName
Do While Len(StrFile) > 0
CheckVal = InStr(1, StrFile, "Address Change Circulation -", vbTextCompare) + _
InStr(1, StrFile, "Address Change Circulation from ", vbTextCompare)
If CheckVal <> 1 Then 'if the email does not fit the standard, just place it in the cell and
'move on to the next entry
Selection.Value = StrFile
Selection.Interior.Color = RGB(255, 255, 0) 'highlight the cell
Selection.Offset(1, 0).Select
Else
StrName = Right(StrFile, Len(StrFile) - 29) 'trim to the correct size - probably not the
'best way to do this but it works
If Left(StrName, 4) = "from" Then
StrName = Right(StrName, Len(StrName) - 5)
ElseIf Left(StrName, 2) = "om" Then
StrName = Right(StrName, Len(StrName) - 3)
End If
StrName = Left(StrName, Len(StrName) - 4)
Changes = Split(StrName, " and ")
For Each Change In Changes
Names = Split(Change, " to ")
If Len(Names(0)) < 5 Then
Selection.Value = Names(0) & Right(Names(1), Len(Names(1)) - Len(Names(0)))
Else
Selection.Value = Names(0)
End If
If UBound(Names) >= 1 Then 'this is a zero indexed array, checking greater than or
'equal to 1 will check if there are two or more entries
Selection.Offset(0, 1).Value = Names(1) ' in the event that there is no " to " in
'the file name and it hasn't been handeled already
End If
Selection.Offset(1, 0).Select 'select the next cell to accept the next entry
Next
End If
StrFile = Dir
Loop
MsgBox "Make sure to QAQC the new table and update any fields that haven't been properly " & _
"filled in by the automation."
End Sub
".. not all file names are the same so .." I would hope so.
You obviously have to add "Address Change from" to the "CheckVal = .." instruction. AND add all other possible variations!
I suggest you check for each individual case individually and handle each case individually. To handle all cases in one "else" has to be wrong. IMHO.

Resources