I'm trying to create a code in VBA where if the range/column contains the letter a and the cell, C5, is empty, then it will display an error message that the cell is empty. I've been testing this with numbers and have gotten that to work, but I'm having issues with doing it with text. I know the IsEmpty part of the code works because of what I've previously tried.
Sub Null_Test()
'
' Null_Test Macro
'
'
If (Range("A1:A20").Value = "a" And IsEmpty(Range("C5").Value) = True) Then
MsgBox "A is Missing"
End If
End Sub
Along with this code, I've also tried:
If (Range("A1:A20").Find("a", LookIn:=xlValues, MatchCase:=True) And IsEmpty(Range("C5").Value) = True) Then
If (InStr(1, Range("A1:A20"), "a") And IsEmpty(Range("C5").Value) = True) Then
If (CountIf("A1:A20", "a") > 0) And IsEmpty(Range("C5").Value) = True) Then
None of these have worked.
You can use a while loop to check if in range, there is a single letter "a" on it
Sub Null_Test()
Dim i As Integer
i = 1
Do While Cells(i, 1).Cells <> ""
If InStr(Cells(i, 1).Value, "a") And Range("C5").Value = "" Then
MsgBox "A is Missing"
i = i + 1
Else
i = i + 1
End If
Loop
End Sub
if you only want it to run through range("A1:A20") you can use a for loop
Sub Null_Test()
Dim i As Integer
For i = 1 To 20
If InStr(Cells(i, 1).Value, "a") And Range("C5").Value = "" Then
MsgBox "A is Missing"
End If
Next
End Sub
Related
I have an excel file contains 20 columns and 100 rows, If the Value in A2= Reportable certain columns in excel are mandatory and similarly if A2 =Non-Reportable then certain other column values are mandatory, So need an VB script to check this condition if any of the mandatory column cell value is blank then on save of excel file throw an error message and error message should list all the missing column headers and rows. The script should validate all the rows, tried the below code, but not working and also i get mutiple error message instead of single error message
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Cell As Range
Dim flag As Boolean
flag = False
If Cells(1, 1) = "" Then flag = True
For Each Cell In Range("B2:B3")
If Cell = "" Then
MsgBox ("Signoff is missing")
flag = True
Exit For
End If
Next Cell
For Each Cell In Range("D2:D3")
If Cell = "" Then
MsgBox ("tax Regime value is missing")
flag = True
Exit For
End If
Next Cell
For Each Cell In Range("E2:E3")
If Cell = "" Then
MsgBox ("Classification value is missing")
flag = True
Exit For
End If
Next Cell
Cancel = flag
End Sub
update - added error.txt as output
update2 - colour cells red and create error sheet
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet, lastrow As Long, ar(2)
Dim msg As String, c As String
Dim r As Long, i As Long, n As Long
ar(1) = Array("B", "D", "F") ' non-reportable columns
ar(2) = Array("C", "E", "G") ' reportable columns
Set ws = ActiveSheet
With ws
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For r = 2 To lastrow
.Rows(r).Cells.Interior.Pattern = xlNone
n = 0
If LCase(.Cells(r, "A")) = "non-reportable" Then
n = 1
ElseIf LCase(.Cells(r, "A")) = "reportable" Then
n = 2
End If
If n > 0 Then
For i = 0 To UBound(ar(n))
c = ar(n)(i)
If .Cells(r, c) = "" Then
.Cells(r, c).Interior.Color = RGB(255, 0, 0) ' red
msg = msg & vbLf & "Row " & r & " missing " & .Cells(1, c)
End If
Next
End If
Next
End With
Dim wsErr As Worksheet, arErr
If Len(msg) > 0 Then
' create error sheet
arErr = Split(msg, vbLf)
Set wsErr = Sheets.Add(after:=Sheets(Sheets.Count))
wsErr.Name = "Errors " & Format(Now(), "yyyy-mm-dd hhmmss")
wsErr.Cells(1, 1).Resize(UBound(arErr) + 1) = Application.Transpose(arErr)
Open "errors.txt" For Output As #1
Print #1, msg
Close #1
MsgBox "Missing data see error.txt", vbCritical
Cancel = True
Else
MsgBox "All good"
End If
End Sub
I am a beginner on vba, sarching and reading different things about vba I have created a piece of code but doesn't work how I want to. If I search for a specific value the code find it and show on specific textboxes a specific value, but if there are more than one same values (in searching column) I want to make the code go to next one until find every same value, what my actual code doesn't do. Any help on improving this code or any other code that does it I appreciate.
Here is my code,
Private Sub Search_Click()
Dim a As String
Dim b As Double
Dim k As Range
On Error GoTo dontexist:
If Me.TextBox20.Value = "" Or Me.TextBox20.Value = "Number of invoice" Then
Me.Label29.Caption = "Number of invoice"
b = Me.TextBox24.Value
Set k = Sheets("Sheet2").Range("E:E")
r = Application.WorksheetFunction.Match(b, k, 0)
Me.TextBox21.Value = Sheets("Sheet2").Cells(r, 2).Value
Me.TextBox22.Value = Sheets("Sheet2").Cells(r, 8).Value
Me.TextBox23.Value = Sheets("Sheet2").Cells(r, 4).Value
Exit Sub
Else
Me.Label29.Caption = "Sum of invoice"
a = Me.TextBox20.Value
Set k = Sheets("Sheet2").Range("H:H")
r = Application.WorksheetFunction.Match(a, k, 0)
Me.TextBox21.Value = Sheets("Sheet2").Cells(r, 2).Value
Me.TextBox22.Value = Sheets("Sheet2").Cells(r, 5).Value
Me.TextBox23.Value = Sheets("Sheet2").Cells(r, 4).Value
Exit Sub
End If
dontexist:
MsgBox "This record dosn't exist!", vbInformation, "Info!"
End Sub
Add a label to your form to hold the last found row and start the search from there. I have used label30.
Option Explicit
Private Sub Search_Click()
Dim rngSearch As Range, rngFound As Range, sColumn As String
Dim sValue As String, iCount As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet2")
' label to hold row to start search at
If Label30 = "" Then Label30 = "1"
If Len(TextBox24) > 0 Then
' search on number
sValue = TextBox24
sColumn = "E"
Label29 = "Number of invoice"
ElseIf Len(TextBox20) > 0 Then
' search on total
sValue = TextBox20
sColumn = "H"
Label29 = "Sum of invoice"
Else
MsgBox "No search values entered", vbExclamation
Exit Sub
End If
' count number of matches
Set rngSearch = ws.Cells(1, sColumn).EntireColumn
iCount = Application.WorksheetFunction.CountIf(rngSearch, sValue)
If iCount > 0 Then
' continue search from last position
Set rngFound = rngSearch.Find(sValue, _
After:= ws.Range(sColumn & Label30), _
LookIn:=xlValues, _
LookAt:=xlWhole)
If rngFound Is Nothing Then
' not found
Label30 = ""
MsgBox "No more records found"
Else
' is row new
If rngFound.Row > Label30 Then
'MsgBox rngFound.Row
' copy into text boxes
With rngFound.EntireRow
If sColumn = "E" Then
TextBox21 = .Cells(1, 2)
TextBox22 = .Cells(1, 8)
TextBox23 = .Cells(1, 4)
Else
TextBox21 = .Cells(1, 2)
TextBox22 = .Cells(1, 5)
TextBox23 = .Cells(1, 4)
End If
End With
Label30 = rngFound.Row
Else
MsgBox "No more records found", vbExclamation
Label30 = ""
Exit Sub
End If
End If
Else
MsgBox "No records found", vbExclamation
Label30 = ""
End If
End Sub
I have encountered a few issues with some code in VBA. I am trying to have the changes made to a cells on an excel sheet show up in comments on the cell the change was made to and I wish for these changes to be stored in a list so I can view them all later. I have tried lots of different pieces of code I have found to try and implement it into the code but none have worked.
Any ideas on how to get this to work?
Worksheet
The below code is what I am currently using
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Adding As Boolean, Finding As Boolean, Subtracting As Boolean
Dim f As Range, v
Select Case Target.Address(True, True)
Case "$A$4": Adding = True
Case "$C$4": Subtracting = True
Case "$E$4": Finding = True
Case Else: Exit Sub
End Select
v = Trim(Target.Value)
If Len(v) = 0 Then Exit Sub
Set f = Me.Range("C8").Resize(1000, 1).Find(v, lookat:=xlWhole)
If Adding Then
If f Is Nothing Then
'not found: add as new row
Set f = Me.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
f.Value = v
End If
f.Offset(0, 1).Value = f.Offset(0, 1).Value + 1
doDate f.Offset(0, 2)
Target.Value = ""
ElseIf Subtracting Then
If f Is Nothing Then
MsgBox v & " not found for subtraction!"
Else
f.Offset(0, 1).Value = f.Offset(0, 1).Value - 1
doDate f.Offset(0, 3)
Target.Value = ""
End If
Else 'finding
If Not f Is Nothing Then
f.EntireRow.Select
Target.Value = ""
Else
MsgBox v & " not found."
End If
End If
If Adding Or Subtracting Then Target.Select
End Sub
Sub doDate(c As Range)
With c
.NumberFormat = "m/d/yyyy h:mm AM/PM"
.Value = Now
End With
End Sub
I have implemented a few formulas on the worksheet but don't see any reason why it would matter in this situation since they only track quantity of items with the same unique identifier.
I also tried some code that added comments to the cells as they were changed that worked but always returned the previous cell value as blank. It is not actually added into the current code though.
Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Target.ClearComments
Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & "Revised " & Format(Date, "mm-dd-yyyy") & Chr(10) & "By " & Environ("UserName")
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = "" Then
preValue = "a blank"
Else: preValue = Target.Value
End If
End Sub
By and large, the code below should do what you want. I marveled at your use of A4 and C4 to express addition and subtraction. As it is, whatever you change in those two cells, apart from clearing them, will result in a quantity of 1 being added or subtracted. I would have expected that a quantity must be entered there which is processed. If the quantity is fixed at 1 the system appears too elaborate.
Anyway, here's the code. I guess you'll be able to modify it to better suit your needs.
Private Sub Worksheet_Change(ByVal Target As Range)
' 038
Dim LookUp As Variant ' subject
Dim Action As Variant ' add = 1, subtract = -1, find = 2
Dim Fnd As Range ' Result of Find method
Dim Txt As String ' comment text
With Target
If (.Row <> 4) Or (.CountLarge > 1) Then Exit Sub
LookUp = Cells(4, "E").Value
On Error Resume Next
Action = Array(0, 1, 0, -1, 0, 2)(.Column)
End With
If Action And (LookUp <> "") Then
' C8 to end of column C
With Range(Cells(8, "C"), Cells(Rows.Count, "C").End(xlUp))
Set Fnd = .Find(LookUp, .Cells(.Cells.Count), xlValues, xlWhole, xlByRows)
End With
End If
If Fnd Is Nothing Then
Select Case Action
Case -1
MsgBox """" & LookUp & """ not found.", vbInformation, "Can't subtract"
Action = -2
Case 2
MsgBox """" & LookUp & """ not found.", vbInformation, "No record"
Action = -2
Case Else
Set Fnd = Cells(Rows.Count, "C").End(xlUp).Offset(1)
Fnd.Value = LookUp
End Select
End If
With Fnd
If Abs(Action) <> 2 Then
With .Offset(0, 1)
If .Comment Is Nothing Then
.AddComment
Else
Txt = Chr(10)
End If
Txt = "Previous Qty = " & .Value & Chr(10) & _
"Revised " & Format(Date, "mm-dd-yyyy") & Chr(10) & _
"by " & Environ("UserName") & Txt
.Comment.Text Txt, 1, False
.Value = Val(.Value) + Action
With .Offset(0, 2)
.NumberFormat = "m/d/yyyy h:mm AM/PM"
.Value = Now
End With
End With
ElseIf Action = 2 Then
.EntireRow.Select
End If
End With
If Action <> 2 Then Target.Select
End Sub
This is for a textbox after update. It will only filter if there's a value more than 0. However, I can't seem to find out where to add that it prompts an error message if a value is keyed in but cannot be found in the filter range
If tbAC.TextLength > 0 Then
AGCN = Rows("1:1").Find(what:="AGC", lookat:=xlWhole).Column
ActiveSheet.ListObjects("Table1").Range.AutoFilter field:=AGCN, Criteria1:=tbAC
'Assuming that I'm supposed to add a line of code here, smth along the line of if criteria:=""
'Msgbox "Invalid Input"
ElseIf tbAC.TextLength = 0 Then
tbAC = ""
End If
Success edit!
Private Sub tbAC_AfterUpdate()
Dim AGCN As Long
Dim AGCL As String
Dim Namef As Range
AGCN = Rows("1:1").Find(what:="AGC", lookat:=xlWhole).Column
AGCL = Split(Cells(1, AGCN).Address, "$")(1)
If tbAC.TextLength > 0 Then
'Set Namef = Range(AGCL:AGCL).Find(tbAC)
Set Namef = Range(AGCL & ":" & AGCL).Find(tbAC)
If Namef Is Nothing Then
MsgBox ("Invalid Input")
Else
ActiveSheet.ListObjects("Table1").Range.AutoFilter field:=AGCN, Criteria1:=tbAC
End If
ElseIf tbAC.TextLength = 0 Then
tbAC = ""
End If
End Sub
Use a VariantVariable for AgentCodeN and use Application.Match like this:
Option Explicit
Sub test()
Dim AgentCodeN As Variant
If tbAC.TextLength > 0 Then
tbAC = tbAC
AgentCodeN = Application.Match(Rows("1:1"), "AGC", 0)
If Not IsError(AgentCodeN) Then
ActiveSheet.ListObjects("Table1").Range.AutoFilter field:=AGCN, Criteria1:=tbAC
'Assuming that I'm supposed to add a line of code here, smth along the line of if criteria:=""
Else
MsgBox "Invalid Input"
End If
ElseIf tbAC.TextLength = 0 Then
tbAC = ""
End If
End Sub
I don't know if you declared your variables but using Option Explicit will force you to do so.
I have a Userform with a listbox for which I am using conditional logic to determine output values to the sheet of selected or non-selected items in the listbox. The issue is that when the Textbox (Tbl_AliasName) is blank, the code executes this:
ElseIf .Selected(k) = True And Tbl_AliasName = vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Trim(Cells(2, 1).Value2) & "." & .Column(1, k)
But if Tbl_AliasName is not blank then the code does nothing, but it is supposed to do this:
ElseIf .Selected(k) = True And Tbl_AliasName <> vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Tbl_AliasName & "." & .Column(1, k)
I have used several variations of If statements, and non of which have worked.
Below is My Code:
Option Explicit
Public Tbl_AliasName As String
Tbl_AliasName = Trim(UserForm_Finder.txtConcat.Value)
Private Sub BtnConcat_Click()
Dim k As Long, lstbxRow As Long, LR As Long
lstbxRow = 1
'****************
'This if statement works perfectly
If (Cells(2, 1).Value2 = vbNullString Or Cells(2, 2).Value2 = vbNullString) _
And Tbl_AliasName = vbNullString Then
MsgBox "You must Search for a Table or Column first.", _
vbExclamation, "Error Encountered"
Exit Sub
ElseIf (UserForm_Finder.ListBx_TblsCols.ListCount = 0 And Tbl_AliasName <> vbNullString) Then
MsgBox "You must Search for a Table or Column first.", _
vbExclamation, "Error Encountered"
'(Cells(2, 1).Value2 = vbNullString Or Cells(2, 2).Value2 = vbNullString) And _
Exit Sub
End If
With UserForm_Finder.ListBx_TblsCols
For k = 0 To .ListCount - 1
'****************
This is where the problems begin
If .Selected(k) = False Then
MsgBox "You must Select 1 or more items from the list box.", _
vbExclamation, "Error Encountered"
Exit Sub
ElseIf .Selected(k) = True And Tbl_AliasName <> vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Tbl_AliasName & "." & .Column(1, k)
ElseIf .Selected(k) = True And Tbl_AliasName = vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Trim(Cells(2, 1).Value2) & "." & .Column(1, k)
End If
Next k
End With
End Sub
My goal is to do the following:
If a Textbox (Tbl_AliasName) is not blank and the user has selected one or more items in the listbox (ListBx_TbleCols) then concatenate the Tbl_AliasName to the selected items in the listbox
If Tbl_AliasName is blank, then use the value in Cells(2,1) to concatenate to the selected Items in the list box.
I have tried the following additions:
Dim LstBxItemSelected As Boolean
'This was placed in the for loop
LstBxItemSelected = True
'this was placed outside the for loop
If LstBxItemSelected = False Then
MsgBox "You must Select 1 or more items from the list box.", _
vbExclamation, "Error Encountered"
Exit Sub
End If
Is there a better way to tell if items are selected, because I feel that the way I have it structured in my loop, the code will throw the error if everything isn't selected? Thank you in advance for any ideas, answers, or suggestions!
Note: The Listbox is populated by the click of another button on the userform which calls the following sub:
Sub FillLstBxCols()
Dim ListBx_Target As MSForms.ListBox
Dim rngSource As Range
Dim LR As Long
If Cells(2, 1).Value2 <> vbNullString Then
LR = Worksheets("New TRAX").Cells(Rows.Count, 2).End(xlUp).Row
'Set reference to the range of data to be filled
Set rngSource = Worksheets("New Trax").Range("A" & 2 & ":" & "B" & LR)
'Fill the listbox
Set ListBx_Target = UserForm_Finder.ListBx_TblsCols
With ListBx_Target
.RowSource = rngSource.Address
End With
End If
End Sub
Hard to say without sample data and expected results, but I think this is what you're looking for:
Private Sub btnConcat_Click()
Dim ws As Worksheet
Dim bSelected As Boolean
Dim sConcat As String
Dim i As Long, lRowIndex As Long
Set ws = ActiveWorkbook.Sheets("New TRAX")
lRowIndex = 1
bSelected = False
sConcat = Trim(Me.txtConcat.Text)
If Len(sConcat) = 0 Then sConcat = Trim(ws.Cells(2, "A").Value)
If Len(sConcat) = 0 Then
MsgBox "You must Search for a Table or Column first.", vbExclamation, "Error Encountered"
Exit Sub
End If
For i = 0 To Me.ListBx_TblsCols.ListCount - 1
If Me.ListBx_TblsCols.Selected(i) Then
If bSelected = False Then
bSelected = True
ws.Range("C2", ws.Cells(ws.Rows.Count, "C")).Clear 'clear previous concat results (delete this line if not needed)
End If
lRowIndex = lRowIndex + 1
ws.Cells(lRowIndex, "C").Value = sConcat & "." & Me.ListBx_TblsCols.List(i)
End If
Next i
If bSelected = False Then MsgBox "Must select at least one item from the list"
End Sub