I have two listboxes in my script which are populated with Month values and Year values. If the listbox is populated with values, it writes them to a worksheet, whereas if they are blank, it should throw an error.
I created a test scenario where I have two blank listboxes, the code below should throw a message box advising the user to select a value before executing the script. However, VBA has a mind of its own and thinks that the list boxes are populated with values, therefore I get:
Runtime Error 1004 - Unable to get the List property of the DropDown class
Is there something wrong with the code below that I am not seeing?
Sub TestDropDown()
Dim MonthBox As DropDown, YearBox As DropDown
Dim WB As Workbook
Dim WS4 as Worksheet
Set WB = ThisWorkbook
Set WS4 = WB.Worksheets("Config")
Set MonthBox = ThisWorkbook.Worksheets("Control Sheet").DropDowns("Drop Down 8")
Set YearBox = ThisWorkbook.Worksheets("Control Sheet").DropDowns("Drop Down 9")
'Check Monthbox for values
If IsNull(MonthBox.Value) Then
MsgBox ("Select a Month before running the script")
Failvalue = 1
GoTo EndSub:
Else
WS4.Cells(2, 9).Value = MonthBox.List(MonthBox.Value)
End If
'Check Yearbox for values
If IsNull(YearBox.Value) Then
MsgBox "Please select a Year before running the script", vbExclamation
Failvalue = 1
GoTo EndSub:
Else
WS4.Cells(2, 10).Value = YearBox.List(YearBox.Value)
End If
EndSub:
If Failvalue = 0 Then
MsgBox ("Process complete")
Else
MsgBox "Process failed to complete", vbCritical
End If
WS4.Visible = xlSheetHidden
End Sub
You should check the .ListIndex instead of the .Value. If ListIndex returns zero, it means none is selected.
Try this:
Sub TestDropDown()
Dim MonthBox As DropDown, YearBox As DropDown, Failvalue As Integer
Dim WB As Workbook
Dim WS4 As Worksheet
Set WB = ThisWorkbook
Set WS4 = WB.Worksheets("Config")
Set MonthBox = ThisWorkbook.Worksheets("Control Sheet").DropDowns("Drop Down 8")
Set YearBox = ThisWorkbook.Worksheets("Control Sheet").DropDowns("Drop Down 9")
'Check Monthbox for values
'If IsNull(MonthBox.Value) Then
If MonthBox.ListIndex = 0 Then
MsgBox ("Select a Month before running the script")
Failvalue = 1
GoTo EndSub:
Else
WS4.Cells(2, 9).Value = MonthBox.List(MonthBox.ListIndex)
End If
'Check Yearbox for values
'If IsNull(YearBox.Value) Then
If YearBox.ListIndex = 0 Then
MsgBox "Please select a Year before running the script", vbExclamation
Failvalue = 1
GoTo EndSub:
Else
WS4.Cells(2, 10).Value = YearBox.List(YearBox.ListIndex)
End If
EndSub:
If Failvalue = 0 Then
MsgBox ("Process complete")
Else
MsgBox "Process failed to complete", vbCritical
End If
WS4.Visible = xlSheetHidden
End Sub
It looks like the following line of code wasn't sufficent as the listbox value wasn't equating to null.
If IsNull(YearBox.Value) then
If a ran a msgbox on the listbox value, it was returning 0 on a blank listbox so I changed the code to the following
If YearBox.Value = 0 then
This works fine!
Related
I don't understand why I get the error message repeated many times when data is inserted wrong more then 2 times i.e. column A. So if 3 mistakes are in column A, then the message pops up 3 times. I set Mwarning as boolean but I guess it is not set properly.
Can anyone guide me in solving this issue?
Dim aRec As Worksheet, bRec As Worksheet, wb As Workbook
Dim match
Dim Mwarning As Boolean
Dim c as long
Set wb = Excel.ActiveWorkbook
Set aRec = wb.Worksheets(1)
Set bRec = wb.Worksheets(2)
Application.ScreenUpdating = False
For c = 2 To aRec.Cells(Rows.Count, "A").End(xlUp).Row
match = Application.match(aRec.Cells(c, 1).Value, bRec.Columns(2), 0)
If IsError(match) And Not IsEmpty(aRec.Cells(c, 1)) Then
aRec.Cells(c, 1).Interior.Color = RGB(255, 0, 0)
MsgBox "Mistakes are in column A", vbInformation, "IMPORTANT:"
Mwarning = True
Else
aRec.Cells(c, 1).Interior.Color = RGB(255, 255, 255)
End If
Next c
If Mwarning = True Then MsgBox "No errors found!", vbInformation, "IMPORTANT:" ' if an error is set in column A, then do nothing, otherwise get the next message
Application.ScreenUpdating = True
EDIT :
Replace you msgbox in the loop by a log like this and add only one msgbox at the end of the sub :
Sub testMsg()
Dim aRec As Worksheet, bRec As Worksheet, wb As Workbook
Dim match
Dim c As Long
Set wb = Excel.ActiveWorkbook
Set aRec = wb.Worksheets(1)
Set bRec = wb.Worksheets(2)
Application.ScreenUpdating = False
Dim log As String
log = ""
For c = 2 To aRec.Cells(Rows.Count, "A").End(xlUp).Row
match = Application.match(aRec.Cells(c, 1).Value, bRec.Columns(2), 0)
If IsError(match) And Not IsEmpty(aRec.Cells(c, 1)) Then
aRec.Cells(c, 1).Interior.Color = RGB(255, 0, 0)
log = "Mistakes are in column A"
Else
aRec.Cells(c, 1).Interior.Color = RGB(255, 255, 255)
End If
Next c
If log = "" Then
MsgBox "No errors found!", vbInformation, "IMPORTANT:" '
Else
MsgBox log, vbInformation, "IMPORTANT:"
Application.ScreenUpdating = True
End Sub
You add a msgbox function in a loop MsgBox "Mistakes are in column A", vbInformation, "IMPORTANT:"
So I think that msgbox will be repeated every time if the IF condition is encountered.
You add a msgbox function in a loop MsgBox "Mistakes are in column A", vbInformation, "IMPORTANT:"
So I think that msgbox will be repeated every time if the IF condition is encountered.
Delete this.
EDIT: improved answer that leaves the cell coloring alone without adding another IF. Msg will only fire once, the Row locations will be reported in a single msgbox as the error string is built inside of your loop, be careful if there are many errors.
Dim aRec As Worksheet, bRec As Worksheet, wb As Workbook
Dim match
Dim Mwarning As Boolean
Dim c As Long
Dim rpt As String
Set wb = Excel.ActiveWorkbook
Set aRec = wb.Worksheets(1)
Set bRec = wb.Worksheets(2)
Application.ScreenUpdating = False
Mwarning = False 'Always, Always, Always set an intitial condition
rpt = "WARINING: Column A Errors are Found" & vbNewLine & vbNewLine
For c = 2 To aRec.Cells(Rows.Count, "A").End(xlUp).Row
match = Application.match(aRec.Cells(c, 1).Value, bRec.Columns(2), 0)
'Added the piece that if there is an error, check if the box has already fired = true,
'if it has NOT fired, then fire it once and not again
If IsError(match) And Not IsEmpty(aRec.Cells(c, 1)) Then
aRec.Cells(c, 1).Interior.Color = RGB(255, 0, 0)
Mwarning = True
rpt = rpt & "Error Found at Row: " & c & vbNewLine
Else
aRec.Cells(c, 1).Interior.Color = RGB(255, 255, 255)
End If
Next c
'You only want this to pop if no errors are found in the FOR LOOP
If Mwarning = False Then
'if no error was found report this message
MsgBox "No errors found!", vbInformation, "IMPORTANT:"
Else 'error was found in column A so Mwarning is true
MsgBox rpt, vbInformation, "IMPORTANT:"
End If
Application.ScreenUpdating = True
You have set Mwarning as Booleanand you set it to True when a mistake is found, but you do not check for its value in the loop. So, the if in the loop should also check for Mwarning value.
I'm not sure why, but when my if statement is false and my msgbox is called I have to click okay 4 times for it to go away. How do I correct this?
My code:
Option Explicit
Private tskCol As String
Private unitCol As String
Private Sub txtTask_Change()
End Sub
Public Sub UserForm_Initialize()
tskCol = Application.InputBox("Enter Column Letter for Task Names", Type:=2)
unitCol = Application.InputBox("Enter Column Letter for Number of Units", Type:=2)
End Sub
Private Sub cmdAdd_Click()
Dim LastRow As Long, i As Long
LastRow = ActiveSheet.Range(tskCol & Rows.Count).End(xlUp).Row
'Copy input values to sheet
For i = 2 To LastRow
If CStr(ActiveSheet.Range(tskCol & i).Value) = CStr(Me.txtTask.Value) Then
ActiveSheet.Range(unitCol & i).Value = Me.txtQuantity.Value
Else
MsgBox "Task Not Found!"
End If
Next i
'Clear input controls
Me.txtTask.Value = ""
Me.txtQuantity.Value = ""
End Sub
To answer your specific question, try changing this line on the Else statement:
Msgbox "Task Not Found"
to
If i = LastRow Then Msgbox "Task Not Found"
You might also want to put Exit For if the task is found. Refactoring IF statement:
If CStr(ActiveSheet.Range(tskCol & i).Value) = CStr(Me.txtTask.Value) Then
ActiveSheet.Range(unitCol & i).Value = Me.txtQuantity.Value
Exit For '/* no need to continue the loop, task is found */
Else
'/* only call msgbox if all rows are processed */
If i = LastRow Then Msgbox "Task Not Found"
End If
This VBA script should take the value in the cell A37 and check if its in the C column of another worksheet. When the number is found the column to the left should be changed to 0. If it is already 0 then a message box will inform the user and if the number does not exist another message box will inform them of this.
This is the VBA I am using to accomplish this. However, every time I try to run it there is a "compile error: Next without For"
Update This issue now is that I need to activate the cell that the fcell is in before doing an Active.cell offset
Sub Cancelled()
Dim x As Long
Dim regRange As Range
Dim fcell As Range
x = ThisWorkbook.Sheets("Welcome").Range("A37").Value
Set regRange = ThisWorkbook.Sheets("Registration").Range("C:C")
For Each fcell In regRange.Cells
If fcell.Value = x Then
ActiveCell.Offset(0, -1).Select
If ActiveCell.Value = 1 Then
ActiveCell.Value = 0
MsgBox "Changed to zero"
Exit Sub
Else
MsgBox "That registration number is already cancelled"
Exit Sub
End If
End If
Next fcell
MsgBox "That number does not exist"
End Sub
Edit for new question: No need to use Select and ActiveCell
If fcell.Value = x Then
If fcell.Offset(0,-1).Value = 1 Then
fcell.Offset(0,-1).Value = 0
...
Edit 2: A further suggestion: You could also use the Range.Find method. This will throw an error if nothing is found so you have to catch that:
On Error Resume Next 'If an error occurs, continue with the next line
Set fcell = regRange.Find(x)
On Error GoTo 0 'disable the error handler
If fcell Is Nothing Then 'If Find failed
MsgBox "That number does not exist"
Else
'do your stuff with fcell here
End If
Hope this is not too late to answer your question:
Sub Cancelled()
Dim x As Long
Dim regRange As Range
Dim fcell As Range
x = ThisWorkbook.Sheets("Welcome").Range("A7").Value
Set regRange = ThisWorkbook.Sheets("Registration").Range("C:C")
For Each fcell In regRange.Cells
If fcell.Value = x Then
If fcell.Offset(0, -1).Value = 1 Then
fcell.Offset(0, -1).Value = 0
MsgBox "Changed to zero"
Else
MsgBox "That registration number is already cancelled"
End If
Exit Sub
End If
Next fcell
MsgBox "That number does not exist"
End Sub
Instead of
Set regRange = ThisWorkbook.Sheets("Registration").Range("C:C")
its better to get the last row in Column C and then set your range as:
Dim lastRow As Long
lastRow = ThisWorkbook.Sheets("Registration").Cells(Rows.Count, "C").End(xlUp).Row
Set regRange = ThisWorkbook.Sheets("Registration").Range("C1:C" & lastRow)
Basically the module Onboarding is asking the path of the tracker i want to update. I am updating details in the
sheet1 of the tracker.
I am setting the values of fields in userform 'OnboardingForm' to blank(so that the values entered last time to the
form is not visible when I am opening the form this time.
Now I am opening the form 'OnboardingForm' and entering values in the subsequent fields.
I have put a check button in my userform 'OnboardingForm' which is invisible to the front end user.
Now in the tracker there is a sheet named 'Project Tracks' which has information of all current projects
Once the submit button is clicked the control will go to the tracker's 'Project Tracks' sheet. It will validate the
track entered in the userform 'OnboardingForm' with the tracks present in the tracker's 'Project Tracks' sheet. Once found the other details against that particular track will get fetched to the tracker's sheet1(this I have done so that I will not have to enter values manually to the userform 'OnboardingForm' so that the form looks simple). There are no chances of the track not
matching.
Now one command button new track has been put in my current userform 'OnboardingForm'. Once clicked this will take the control to
the userform2 'ProjectTracksForm'.This is basically put so that if I am adding a new track, the form takes the detail and enters in the
tracker's 'Project Tracks' sheet.
Question 1> My current userform's Track button is a combo box. How do I add values in the dropdown from the tracker's
'Project Tracker' sheet to the dropdown.
Question 2> Once I add a new track in userform2 'ProjectTracksForm',submit and then when I come back to my current
userform 'OnboardingForm' that added track should be shown in the dropdown of Track combo box.
Please find below my piece of code.
This is my module for onboarding
Public Sub OnBoarding()
On Error GoTo ErrorHandler
Dim Owb As Object
Dim ran As Range
strTalentTrackerPath = shTracker.Cells(2, 2).Value
'Default the form values to null
With OnboardingForm
.combTrackofWork.Value = ""
.txtFirstName.Text = ""
.txtLastName.Text = ""
.combResCat.Value = ""
.combBFTE.Value = ""
.combLevel.Value = ""
.combLocType = ""
.txtAccessInfo.Text = ""
End With
OnboardingForm.Show
SetFocus.combTrackofWork
With OnboardingForm
'Details to be entered in the form'
strTOW = Trim$(.combTrackofWork.Value)
strFN = Trim$(.txtFirstName.Text)
strLN = Trim$(.txtLastName.Text)
strResCat = Trim$(.combResCat.Value)
strBilFTE = Trim$(.combBFTE.Value)
strLevel = Trim$(.combLevel.Value)
strLocType = (.combLocType.Value)
strAccessInfo = (.txtAccessInfo.Text)
End With
If OnboardingForm.chkOKButtonClick = True Then
Set oExcel = New Excel.Application
strMyFolder = strTalentTrackerPath
Set Owb = oExcel.Workbooks.Open(strMyFolder)
IntRowCount = Owb.Sheets(1).UsedRange.Rows.Count
With Owb.Sheets(1)
With Owb.Sheets("Project Tracks")
IntTrackRowCount = .UsedRange.Rows.Count
For IntCurrentRow = 1 To IntTrackRowCount
If .Cells(IntCurrentRow, 1) = strTOW Then
Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colTrackofWork) _
= .Cells(IntCurrentRow, ProjectTrackscolumn.colTrack)
Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colBPO) = .Cells _
(IntCurrentRow, ProjectTrackscolumn.colBPO)
Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colCostCenter) _
= .Cells(IntCurrentRow, ProjectTrackscolumn.colCostCenter)
Owb.Sheets(1).Cells(IntRowCount + 1, OnboardingFormcolumn.colGroup) _
= .Cells(IntCurrentRow, ProjectTrackscolumn.colGroup)
Exit For
End If
Next
End With
End With
.Cells(IntRowCount + 1, OnboardingFormcolumn.colTrackofWork) = strTOW
.Cells(IntRowCount + 1, OnboardingFormcolumn.colFirstName) = strFN
.Cells(IntRowCount + 1, OnboardingFormcolumn.colLastName) = strLN
.Cells(IntRowCount + 1, OnboardingFormcolumn.colResourceCategory) = strResCat
.Cells(IntRowCount + 1, OnboardingFormcolumn.colBilledFTE) = strBilFTE
.Cells(IntRowCount + 1, OnboardingFormcolumn.colLevel) = strLevel
.Cells(IntRowCount + 1, OnboardingFormcolumn.colLocationType) = strLocType
.Cells(IntRowCount + 1, OnboardingFormcolumn.colAccessInformation) = strAccessInfo
Owb.Close True
Set Owb = Nothing
Set oExcel = Nothing
Else
Exit Sub
End If
Exit Sub
ErrorHandler:
If Owb Is Nothing Then
Else
Owb.Close False
End If
If oExcel Is Nothing Then
Else
Set oExcel = Nothing
End If
MsgBox "Unhandled Error. Please Report" & vbCrLf & "Error Description: " & _
Err.Description, vbExclamation
End Sub
This is for cancel button of Onboarding Form
Private Sub cmdbtn_Cancel_Click()
OnboardingForm.Hide
MsgBox ("No data entered")
End Sub
This is for OnboardingForm submit button
Private Sub cmdbtn_Submit_Click()
If Trim(OnboardingForm.combTrackOfWork.Value) = "" Then
OnboardingForm.combTOW.SetFocus
MsgBox ("Track of Work cannot be blank")
Exit Sub
End If
If Trim(OnboardingForm.txtFirstName.Value) = "" Then
OnboardingForm.txtFN.SetFocus
MsgBox ("First name cannot be blank")
Exit Sub
End If
If Trim(OnboardingForm.txtLastName.Value) = "" Then
OnboardingForm.txtLN.SetFocus
MsgBox ("Last name cannot be blank")
Exit Sub
End If
End Sub
Module for Project Tracks
Public Sub prjctTracks()
On Error GoTo ErrorHandler
Dim Owb As Object
strTalentTrackerPath = shTracker.Cells(2, 2).Value
With ProjectTracksForm
.txtTOW = ""
.txtBPO = ""
.txtCOCE = ""
.txtSOW = ""
.txtGroup = ""
End With
ProjectTracksForm.Show
With ProjectTracksForm
strTOW = Trim$(.txtTOW.Text)
strBPO = Trim$(.txtBPO.Text)
strCOCE = Trim$(.txtCOCE.Text)
strSOW = Trim$(.txtSOW.Value)
strGroup = Trim$(.txtGroup.Value)
End With
ProjectTracksForm.Hide
If ProjectTracksForm.chkbtn_OKclick = True Then
Set oExcel = New Excel.Application
strMyFolder = strTalentTrackerPath
Set Owb = oExcel.Workbooks.Open(strMyFolder)
With Owb.Sheets("Project Tracks")
intUsedRowCount = .UsedRange.Rows.Count
.Cells(intUsedRowCount + 1, Trackscolumn.colTrack) = strTOW
.Cells(intUsedRowCount + 1, Trackscolumn.colBPO) = strBPO
.Cells(intUsedRowCount + 1, Trackscolumn.colCostCenter) = strCOCE
.Cells(intUsedRowCount + 1, Trackscolumn.colSOW) = strSOW
.Cells(intUsedRowCount + 1, Trackscolumn.colGroup) = strGroup
End With
Owb.Close True
Set Owb = Nothing
Set oExcel = Nothing
Else
Exit Sub
End If
Exit Sub
ErrorHandler:
If Owb Is Nothing Then
Else
Owb.Close False
End If
If oExcel Is Nothing Then
Else
Set oExcel = Nothing
End If
MsgBox "Unhandled Error. Please Report" & vbCrLf & "Error Description: " & _
Err.Description, vbExclamation
End Sub
Question 1> My current userform's Track button is a combo box. How do
I add values in the dropdown from the tracker's 'Project Tracker'
sheet to the dropdown.
I am calling the combobox "ComboBox1" in this example
The Range to place in the combobox would look like this...
The code to populate the combobox would be in the Userform Module.
Private Sub UserForm_Initialize()
Dim LstRw As Long
Dim Rng As Range
Dim ws As Worksheet
Set ws = Sheets("Project Tracker")
With ws
LstRw = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng = .Range("A2:A" & LstRw)
End With
ComboBox1.List = Rng.Value
End Sub
Question 2> Once I add a new track in userform2
'ProjectTracksForm',submit and then when I come back to my current
userform 'OnboardingForm' that added track should be shown in the
dropdown of Track combo box
When you activate your userform again, you can clear the combobox and repopulate it with the new list.
Private Sub UserForm_Activate()
Dim LstRw As Long
Dim Rng As Range
Dim ws As Worksheet
Set ws = Sheets("Project Tracker")
With ws
LstRw = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng = .Range("A2:A" & LstRw)
End With
ComboBox1.Clear
ComboBox1.List = Rng.Value
End Sub
I assume that somewhere you would have a code that will add a new item to the List in sheet("Project Tracker"),
Something like:
Private Sub CommandButton1_Click()
'THIS IS IN THE OTHER USERFORM
'add item to first blank cell in column A sheets("Project Tracker")
Dim sh As Worksheet
Dim LstRws As Long
Set sh = Sheets("Project Tracker")
With sh
LstRws = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(LstRws, 1) = "SomeThingNew" 'whatever you are adding to the list
End With
End Sub
The code will add something new to the list in your worksheet.
When you show the form again, the new item will be in the combobox.
You can either use a Button, Combobox event, textbox event, to add the item to the new list.
new to VBA here. I've been stuck on this problem for a while now:
Essentially, I need to create a macro that copies over specific data from one sheet to another, that is up to the user to specify. The catch is that while all the data is in one column (B), not all rows of the column have relevant entries; some are blank and some have other data that I don't want.
Only entries that begin with 4 numbers are wanted. I can't seem to get how the iterated copy-pasting works; what I've come up with is as follows:
'defining input
Dim dater As Date
dater = Range("B2")
If dater = False Then
MsgBox "Date not specified"
Exit Sub
End If
Dim sheetin As String
sheetin = Range("B5")
If sheetin = "" Then
MsgBox "Input Sheet not specified"
Exit Sub
End If
Dim wbin As String
wbin = Range("B4")
If wbin = "" Then
MsgBox "Input workbook not specified"
Exit Sub
End If
Dim sheetout As String
sheetout = Range("B9")
If sheetout = "" Then
MsgBox "Output Sheet not specified"
Exit Sub
End If
Dim wbout As String
wbout = Range("B8")
If wbout = "" Then
MsgBox "Output Workbook not specified"
Exit Sub
End If
Windows(wbout).Activate
Dim sh As Worksheet, existx As Boolean
For Each sh In Worksheets
If sh.Name Like sheetout Then existx = True: Exit For
Next
If existx = True Then
If Sheets(sheetout).Visible = False Then Sheets(sheetout).Visible = True
Else
Sheets.Add.Name = CStr(sheetout)
End If
'copy pasting values
Windows(wbin).Activate
Sheets(sheetin).Select
'specify maximum row
iMaxRow = 500
For iRow = 1 To iMaxRow
With Worksheets(sheetin).Cells(iRow, 2)
'Check that cell is not empty.
If .Value = "####*" Then
.Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Range("A" & i)
'Else do nothing.
End If
End With
Next iRow
End Sub
Subsequently i'll have to match data to these entries that have been copied over but I figure once i get the hang of how to do iterated stuff it shouldn't be too much of a problem. But right now i'm really stuck... Please help!
It looks like it should work, except for that part :
With Worksheets(sheetin).Cells(iRow, 2)
If .Value = "####*" Then
.Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Range("A" & i)
End If
End With
The third line contains an unknown variable : i.
You need to define it to contain the number of the line to which you're copying. For example, if you want to copy to the first available line, try this :
Set wsOut = Workbooks(wbout).Worksheets(sheetout)
With Worksheets(sheetin).Cells(iRow, 2)
If .Value = "####*" Then
i = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Row + 1
.Copy Destination:=wsOut.Range("A" & i)
End If
End With