I am testing a command button to run three checks on an internal stock requisition sheet ("TestOrder") in excel 2007. Where the basic premise is that from a list of inventory parts(goods), the user can enter the quantity required of item/s and specify the customer code for who the goods are for. If any of the required fields are empty then a message will appear and the procedure stops.
They must enter their initials as the Requisitioner from a drop down list in one dedicated cell (D2), and select initials of the user who will process the request from another drop down list in the dedicated cell (F2). Quantities will be entered into the appropriate Row of column L, and the customer code in the same row of column M. This sheet will then be filtered and emailed for processing.
I have, in the main got all of that working, but due to time constraints I had not been able to work on a way of checking that all the data required has been entered prior to the filtered order being emailed anywhere.
I need to check three things:
Step 1, Have both sets of initials been entered
Step 2, If quantities have been entered, then the customer field cannot be blank
Step 3, If a customer has been entered then the quantity field cannot be blank.
So, all three steps have to have data in their cells.
I have got Step 1 working as the dedicated cells D2 and F2 do not change, if either cell is blank, a message appears to the user and stops the procedure.
Whereas the quantities required in column L and the customer codes in column M are variable and would be subject to a filter to remove blanks and show only what has been ordered.
So, I was working up a test initially on a single column (M-customer codes) to check if the number of non-empty cells in range is less than total number of cells in range and this is where the Run time error 424 occurred.
On the line
Set myCellRange = Range("M7:M" & Range("M" & Rows.Count).End(xlUp).Row).Select
where M7 is the top cell of the listed data in that column.
My work in progress code is:
Sub btn_test_checkdata()
' On the click of this button run a check to see if two cells have the required data, in this case they would be Users Initials selected from a drop down list cell'
If [D2].Value = "" Then
MsgBox "There MUST be Initials selected in the Who is ordering Field", vbOKOnly, "Entry Reqd"
[D2].Select
Cancel = True
Exit Sub
End If
If [F2].Value = "" Then
MsgBox "There MUST be Initials selected in the Who is the Req'n being sent to Field", vbOKOnly, "Entry Reqd"
[F2].Select
Cancel = True
Exit Sub
End If
'Sub checkIfAnyCellInRangeIsEmpty()
'declare object variable to hold reference to cell range you work with
Dim myCellRange As Range
'identify cell range you work with
Set myCellRange = Range("M7:M" & Range("M" & Rows.Count).End(xlUp).Row).Select
'check if number of non-empty cells in range is less than total number of cells in range. Depending on result, display message box indicating whether cell range contains any empty cell (True) or not (False)
If WorksheetFunction.CountA(myCellRange) < myCellRange.Count Then
MsgBox myCellRange.Address & " contains at least 1 empty cell"
End If
End Sub
Obviously, I need to extend this check to both columns so any hints on that would be great, as I'm not an expert user my thinking would have me get the code to work for one column then repeat it for the other.
The current error I'm getting now, has it something to do with specifying the worksheet? As I cannot see me doing that anywhere.
Like I say, I have the main operations working in the order sheet, and this is about me building a small procedure to do a final check before anything else happens.
The comment from John Coleman should do the job (move the .Select action):
Dim myCellRange As Range
Set myCellRange = Range("M7:M" & Range("M" & Rows.Count).End(xlUp).Row)
myCellRange.Select '<- this action
Related
I want to look for the word "double" in column N from the first row to the last available row (The total number of rows is extracted from cell E1).
If the word "double" is found, Message box "error" would appear.
Can anyone help me?
Thanks
Welcome to StackOverflow. Next time, please include what you have tried in your question.
This does what you are asking:
Sub findDouble()
' get row number of last row to check
Dim NumberOfCells As Integer
NumberOfCells = ActiveSheet.Range("E1").Value
' loop through all cells in column N
For Each cell In ActiveSheet.Range("N1:N" & NumberOfCells)
' throw error message if cell value equals double
If cell.Value = "double" Then MsgBox "error"
Next cell
End
I'm assuming here that you want to run this on the currenty active worksheet. A more water-proof way is of course to specify the sheet by its name or number.
You probably want to refine the code though, e.g. to include the cell address the 'double' was found in in your error message, like so:
MsgBox "error in cell " & cell.Address
enter image description hereI Have two Excel Sheets ("Record") & ("Register"), " Register" is the database. from this database I need to create Records of each employees based on their employee ID (cell value). i am searching for a VBA code that should give me the training Record a each employee once i have enter their ID in the cell and click "a command button". Attached the Excel screen short for reference.
Steps 1: Enter Employee ID in the "Record" sheet
Step 2: Click command button "Filter" in the Record sheet
Step 3: VBA code to run and filter data from "Register" and fill "Record".
IF i Type another Employee ID in the sheet "Record" , it should ClearContents of the previous query. and produce the data.
Please help me, i am not good in VBA .attached the Excel screen short for reference ( UPDATE on 29/07/2018-Question Solved : sharing the code below; thank you Mr.ComradeMicha for your valuable feedback)
Sub Button2_Click()
'Declare the variables
Dim RegisterSh As Worksheet
Dim RecordSh As Worksheet
Dim EmployeeRange As Range
Dim rCell As Range
Dim i As Long
'Set the variables
Set RegisterSh = ThisWorkbook.Sheets("Register")
Set RecordSh = ThisWorkbook.Sheets("Record")
'Clear old data Record Sheet
RecordSh.Range("A8:F107").ClearContents
Set EmployeeRange = RegisterSh.Range(RegisterSh.Cells(6, 4), RegisterSh.Cells(Rows.Count, 6).End(xlUp))
'I went from the cell row6/column4 (or D6) and go down until the last non empty cell
i = 7
For Each rCell In EmployeeRange 'loop through each cell in the range
If rCell = RecordSh.Cells(4, 2) Then 'check if the cell is equal to "Record"
i = i + 1 'Row number (+1 everytime I found another "Record")
RecordSh.Cells(i, 1) = i - 7 'S No.
RecordSh.Cells(i, 2) = rCell.Offset(0, 2) 'Training name
RecordSh.Cells(i, 3) = rCell.Offset(0, -2) 'End date
RecordSh.Cells(i, 4) = rCell.Offset(0, 6) 'Validity
RecordSh.Cells(i, 5) = rCell.Offset(0, 7) 'Remarks
RecordSh.Cells(i, 6) = rCell.Offset(0, 5) 'Minimal requirement
End If
Next rCell
End Sub
Your code is missing a few essential parts you may want to look into:
It seems to require the user to select a specific row before the macro is started, even though there is a command button to trigger the macro. If the layout stays the same, just use constants to store the row where certain input or lookup fields are located.
ra is used both on the input form and on the lookup sheet. That's asking for trouble... Again, use constants or at least "StartingRow=3" or something similar.
You are correcting your employee number to a format that doesn't fit the data provided in the screenshot. Hopefully just a dummy data issue, but in case you are wondering why you don't find anything ;)
You are typecasting all fields individually. If your layout is always the same, it's much easier to just use the "variant" type for all cell values and make sure you already formatted all columns correctly.
ru is never initialized? It's supposed to be "the next row", why not simply use "ra+1" then instead of ru? Also, TRNRow and RTRNRow are never initialized either.
When you "search" your records, you actually only copy the same row into your results, then "copy next row until employee number is wrong". So this only works for exactly one employee, and even then you only catch the first few trainings. Use the Find function on the employee number cell in the records sheet to find the next row with that id, then copy the row's contents and find next.
I think if you get yourself aquainted with the Find function, you will easily finish this macro on your own. Here's a good guide: https://excelmacromastery.com/excel-vba-find
Good luck!
I am new to VBA and am trying to delete unwanted columns loaded from a .csv file. I am importing a large amount of data but then I ask the user what columns they want to keep going by "ID num.". There are a lot of columns with different ID no. and I want to ask the user what they want to keep and delete the rest.
The problem is I need to delete all the other columns the user didn't want but I still need to keep the first 6 columns and the last two columns as that is different information.
Here is what I have so far:
Sub Select()
'the below will take the users inputs
UserValue = InputBox("Give the ID no. to keep seperating with a comma e.g"12,13,14")
'the below will pass the user inputs to the example to split the values
Call Example(UserValue)
End Sub
Sub Example(UserValue)
TestColArray() = Split(UserValue, ",")
For Each TestCol In TestColArray()
' keep all the columns user wants the delete the rest except the first 6 columns and last 2
Next TestCol
End Sub
That is what I have so far, it is not much but the user could put in a lot of columns with different ID number in the input box the way the Excel sheet is laid out all the ID no.s are in row 2 and the first 6 and last 2 columns are blank of row 2 since the ID no. does not apply. I hope that helps.
try this (commented) code:
Option Explicit '<--| use this statament: at the cost of having to declare all used variable, your code will be much easier to debug and maintainable
Sub MySelect()
Dim UserValue As String
'the below will take the users inputs
UserValue = Application.InputBox("Give the ID no. to keep seperating with a comma e.g: ""12,13,14""", Type:=2) '<--| use Type:=2 to force a string input
'the below will pass the user inputs to the example to split the values
Example UserValue '<--| syntax 'Call Example(UserValue)' is old
End Sub
Sub Example(UserValue As String)
Dim TestCol As Variant
Dim cellsToKeep As String
Dim firstIDRng As Range, lastIDRng As Range, IDRng As Range, f As Range
Set firstIDRng = Range("A2").End(xlToRight) '<-- first ID cell
Set lastIDRng = Cells(2, Columns.Count).End(xlToLeft) '<-- last ID cell
Set IDRng = Range(firstIDRng, lastIDRng) '<--| IDs range
cellsToKeep = firstIDRng.Offset(, -6).Resize(, 6).Address(False, False) & "," '<--| initialize cells-to-keep addresses list with the first six blank cells at the left of first ID
For Each TestCol In Split(Replace(UserValue, " ", ""), ",") '<--| loop through passed ID's
Set f = IDRng.Find(what:=TestCol, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<--| search for the current passed IDs range
If Not f Is Nothing Then cellsToKeep = cellsToKeep & f.Address(False, False) & "," '<--| if the current ID is found then update cells-to-keep addresses list
Next TestCol
cellsToKeep = cellsToKeep & lastIDRng.Offset(, 1).Resize(, 2).Address(False, False) '<--| finish cells-to-keep addresses list with the firts two blank cells at the right of last ID
Range(cellsToKeep).EntireColumn.Hidden = True '<-- hide columns-to-keep
ActiveSheet.UsedRange.EntireColumn.SpecialCells(xlCellTypeVisible).EntireColumn.Delete '<--| delete only visible rows
ActiveSheet.UsedRange.EntireColumn.Hidden = False '<-- unhide columns
End Sub
it's assumed to be working with currently active worksheet
A simple google search produces this. On the first page of results too. Perhaps this will suit your needs.
If the data set that needs to be deleted is really large (larger than the ranges you want to keep too.) Then perhaps only select the columns you want to have whilst you import the csv? This stackoverflow question shows how to import specific columns.
EDIT:
So from what I believe the OP is stating as the problem, there is a large csv file that is being imported into excel. After importing there is alot of redundant columns that should be deleted. My first thought would be to only import the needed data (columns) in the first place. This is possible via VBA by using the .TextToColumns method with the FieldInfo argument. As stated above, the stackoverflow question linked above provides a means of doing so.
If the selective importing is not an option, and you are still keen on making an inverse of the user selection. One option would be to create 2 ranges (one being the user selected Ranges and the second being the entire sheet), you could perform an intersect check between the two ranges and delete the range if there is no intersection present (ie. delete any cell that is not part of the users selection). This method is provided by the first link I supplied and is quite straight forward.
I've a very simple VBA function to copy the value of a cell(which is the summation of a range) to an empty cell. The program loops 50 times, the L53 cell contains the summation of a Range that changes each time as the NORMINV(RAND(),0,1) generates different values per loop.
Sub Run_Calc_Btn_Click()
For i = 1 To 50
Range("O" & i + 1).Value = Range("L53")
Next i
End Sub
However, the copied value does not equal to the original cell value and I couldn't figure out where does this value come from.
I tried running your function and I think that the problem is that after the last loop the value changes again.
If you as a quick debug add the following as the first line inside the for loop: MsgBox "Value of L53: " & Range("L53").Value, you will see that each cell in column O does indeed match the sum in cell L53.
Before you click OK in the messagebox, you can verify that the value in cell L53 is the same as the value shown in the messagebox and after you click OK the next cell in column O will have the value that was just shown in the messagebox.
What would be the best way to write a VBA code to have a message box pop up if the value in one cell is less than or greater than another cell - and then display the difference?
Column N contains total appts (manual input)
Column R contains total results (formula generated)
If the cell in column R after calculated is less than or greater than the cell in column N the message box would pop up and say Total results is less than appts by # or Total results is greater than appts by #.
Add the following routine to your required sheet in the VBA project (e.g. Sheet1)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("N1") Or Target = Range("R1") Then 'Only attempt to run the below code if target is a range you care about
If Range("R1").Value2 <> Range("N1").Value2 Then
MsgBox "Values differ"
End If
End If
End Sub
On the assumption that you want to compare two cells with one another (as opposed to a whole column of cells):
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("N1") > Range("R1") Then
MsgBox "Oops. Results less than Input by " & Abs(Range("N1") - Range("R1"))
End If
If Range("N1") < Range("R1") Then
MsgBox "Oops. Results greater than Input by " & Abs(Range("N1") - Range("R1"))
End If
End Sub
That should achieve the following:
Compare two cells with one another whenever the sheet changes (regardless whether it be the formula generated value for R1, the manual input for N1, or anything else on the sheet)
Identify which is greater
Pop up an appropriate message