I am programming a little and easy add client code. But when I add a client it gives me this little error where I can't get rid off. Maybe it will be an easy solution. Here is my code:
Private Sub btn_Toevoegen_Click()
Dim laatsteKlantNummer As Integer
Range("B4:B13").End(xlDown).Select
laatsteKlantNummer = ActiveCell.Value
ActiveCell.Offset(1, 0).Value = txtKlant
ActiveCell.Offset(1, 1).Value = txtNaam
ActiveCell.Offset(1, 2).Value = txtAdres
ActiveCell.Offset(1, 3).Value = txtWoonplaats
ActiveCell.Offset(1, 4).Value = txtContact
Me.Hide
Range("B4:B13").Sort Key1:=Range("B4:B13"), Order1:=xlAscending
End Sub
This code works properly but the thing happening is when it places it in the excel worksheet it is placed as text and not as number. So it gives me the error: "Number stored as text". After that I can click convert to number. Like this:(http://i.imgur.com/mfMnGFI.png) But is it possible to code it instead of clicking it all the time?
I am not sure on what line you get this error, but for example if its this one:
ActiveCell.Offset(1, 4).Value = txtContact
You can add this to 'convert' it to a number:
ActiveCell.Offset(1, 4).Value = txtContact + 0
Related
I'm still quite new to VBA and I'm basically self-taught. I've developed a spreadsheet for work and I need a macro to allow customers to add information then the information copy to sheet 2 in descending order. This is the code I am using currently attempting to use but when I click on the “Save” macro button, the data stops copying over after two entries. Additionally, is there some code that I can input to clear the blocks so each new customer cannot see what the previous customer entered?
Private Sub CommandButton1_Click()
Dim Name As String, Org As String, POCPhone As String, Email As String, TypeofVeh As String, TotPax As String, TotCar As String, Pickup As String, DateReq As String, DateRet As String, Destination As String, YN As String, Remarks As String
Worksheets("TransReq").Select
Name = Range("B4")
Org = Range("C4")
POCPhone = Range("D4")
Email = Range("E4")
TypeofVeh = Range("F4")
TotPax = Range("G4")
TotCar = Range("H4")
Pickup = Range("I4")
DateReq = Range("J4")
DateRet = Range("K4")
Destination = Range("L4")
YN = Range("M4")
Remarks = Range("N4")
Worksheets("TransReqLog").Select
Worksheets("TransReqLog").Range("B3").Select
If Worksheets("TransReqLog").Range("B3").Offset(1, 1) <> "" Then
Worksheets("TransReqLog").Range("B3").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Name
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Org
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = POCPhone
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Email
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = TypeofVeh
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = TotPax
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = TotCar
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Pickup
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = DateReq
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = DateRet
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Destination
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = YN
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Remarks
Worksheets("TransReq").Select
Worksheets("TransReq").Range("B4").Select
End Sub
"the data stops copying over after two entries." - this means it stops here - ActiveCell.Value = POCPhone A possible reason should be, that POCPhone contains an error. E.g. - Range("D4") is probably #DIV/0 or #Value
There are 3 ways fix it (2 easy and 1 difficult) :
Write On Error Resume Next after Private Sub CommandButton1_Click() - this is really not advisable, because it will ignore every error. But it will fix it.
Rewrite the whole code, avoiding Select and ActiveCell (This is the difficult one). How to avoid using Select in Excel VBA
Write some check like this:
ActiveCell.Offset(0, 1).Select
If Not IsError(ActiveCell) Then ActiveCell.Value = DateRet
Here's a refactored version of your code that should do what you're looking for. Note that the code (including your original version) appears to assume that there is only one line (row 4) from your "TransReq" sheet to move over to the "TransReqLog" sheet:
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim wsData As Worksheet
Dim wsLog As Worksheet
Dim rData As Range
Set wb = ActiveWorkbook
Set wsData = wb.Sheets("TransReq")
Set wsLog = wb.Sheets("TransReqLog")
Set rData = wsData.Range("B4:N4")
wsLog.Cells(wsLog.Rows.Count, "B").End(xlUp).Offset(1).Resize(, rData.Columns.Count).Value = rData.Value
rData.ClearContents
End Sub
As a note, please familiarize yourself with How to avoid using Select in Excel VBA (Vityata also linked here in his answer)
Your code only works for two rows because of this line:
Worksheets("TransReqLog").Range("B3").End(xlDown).Select
The first line is copied successfully as the line of code isn't executed due to the IF statement.
The second line is successful as the code selects cell C3 and then performs the same operation as the keyboard shortcut Ctrl+Down which selects the next cell down that isn't empty. The code then offset by one row.
It breaks on the third attempt as the code does exactly the same as the second attempt - it starts at the empty C3 and moves down to the first cell that's not empty.
Providing all cells below are empty it's better to start at the bottom of the sheet and move upwards to the first cell that's not empty.
Worksheets("TransReqLog").Cells(Worksheets("TransReqLog").Rows.Count, 2).End(xlUp).Select
If there isn't a mixture of XL2003 and XL2007 or later then the you can just use Worksheets("TransReqLog").Cells(Rows.Count, 2).End(xlUp).Select
Having said all that, the refactor that #tigeravatar answered with is the way to go.
Fellow StackOverFlow-ians,
I come to you with another question that i'm trying to learn from.
I have a UserForm which adds Employees to an Employee-database.
Code is as below, and working perfectly.
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Employee-Data")
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 4).Value = Me.TextBox1.Value
ws.Cells(iRow, 3).Value = Me.TextBox2.Value
ws.Cells(iRow, 7).Value = Me.TextBox3.Value
ws.Cells(iRow, 6).Value = Me.TextBox4.Value
ws.Cells(iRow, 15).Value = Me.TextBox5.Value
ws.Cells(iRow, 9).Value = Me.TextBox6.Value
ThisWorkbook.Save
Unload Employee
End Sub
My problem is as following, I want to restrict the format of TextBox6 to a Dutch telephone-number, which is 06-########. I want TextBox6 to show 06- and make it only able to type 8 numbers in as Value.
I've tried the following and more:
Private Sub TextBox6_Change()
TextBox1.Text = Format(ws.Cells(iRow, 9).Value,"##""-"########")
End Sub
What is my error in thinking here, am i using a wrong approach? Can anybody suggest a decent solution for this problem? As said before, trying to learn from my errors, so please tell me what I'm doing wrong instead of just providing a solution.
ws.Cells(iRow, 9).Value = "06-" & Me.TextBox6.Value
Be aware of cell formatting as you may get a date. Convert to text or number etc.
I was wondering if someone could assist me please. I have created a very simple userform to log information. My issue is however when one of the fields is blank I am receiving an error message :
Sub or Function not defined.
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")
'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a Name number
If Trim(QueryType.Value) = "" Then
QueryType.SetFocus
MsgBox "Please complete the form"
Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = Format(Now, "DD/MM/YYYY")
ws.Cells(iRow, 2).Value = Format(Now, "HH:MM")
ws.Cells(iRow, 3).Value = Application.UserName
ws.Cells(iRow, 4).Value = CType.Value
ws.Cells(iRow, 5).Value = IName.Value
ws.Cells(iRow, 6).Value = QType.Value
ws.Cells(iRow, 7).Value = 1
ws.Cells(iRow, 8).Value = Format(Date, "MMM-YY")
'ws.Cells(iRow, 9).Value = Application.WorksheetFunction.VLookup(InternalName.Value, Sheet2.Range("C1:D23"), 2, 0)
'ws.Cells(iRow, 9).Value = Application.WorksheetFunction.IfError(VLookup(InternalName.Value, Sheet2.Range("C1:D23"), 2, 0), "")
ws.Cells(iRow, 10).Value = Application.WorksheetFunction.VLookup(InternalName.Value, Sheet2.Range("C1:E23"), 3, 0)
ws.Cells(iRow, 11).Value = "IB"
Unload Me
MsgBox "Data added", vbOKOnly + vbInformation, "Data Added"
End Sub
The issue is in either one of the commented out lines where I receive the error. I only receive if I leave the dropdown box empty. If populated then no error occurrs. I could easily fit an extra menu option for "Not Applicable" however would rather it was just blank. Does anyone have any suggestions at all please?
Three things.
1- VLookup is not a VBA function on its own, it's a member method of either the Application object or the WorksheetFunction object. So you should qualify VLookup by either, even if you had it inside another method, such as WorksheetFunction.IfError(...).
ws.Cells(iRow, 9).Value =
WorksheetFunction.IfError(WorksheetFunction.VLookup(InternalName.Value, Sheet2.Range("C1:D23"), 2, 0), "")
' ^^^^^^^^^^^^^^^^^^
2- The same methods in WorksheetFunction and in Application objects work differently. In the former, an error is raised in VBA if the result is an error (such as: no match for the searched value). In the latter, no error is raised, but the returned value is an Error Variant. This latter form is usually safer for VBA, because you dont need to have some On Error Resume Next or so, but you can just check the result with If(IsError(result)).
3- When your search criteria is empty or unmatched, you had the error raised due to the use of WorksheetFunction.VLookup (According to 2). If your intention is to just set the resulting value and proceed, you can use Application.VLookup instead:
ws.Cells(iRow, 9).Value = Application.IfError(Application.VLookup(InternalName.Value, Sheet2.Range("C1:D23"), 2, 0), "")
p.s. I personally prefer Application. most of the time. Some prefer WorksheetFunction mostly because it offers Intellisense, but I find that pretty useless, because the arguments of the methods in Intellisense are unnamed and untyped, i.e. VLookup(arg1, arg2, arg3, [arg4]).. (non-sense to me).
I'm creating some code to better keep track of expenses. One of the macros is meant to load fixed expenses from another worksheet, only when the amounts are not empty and, in the case of credits, only if there's still pending payments.
My code is as follows:
Sub CargarFijos()
ActiveSheet.Range("J4").Select
If Not ActiveSheet.Previous Is Nothing Then
If Not ActiveSheet.Previous.Range("C12") Is Nothing Then
If Not IsEmpty(ActiveSheet.Previous.Range("C12")) Then
ActiveCell.Text = "Tarjeta de Credito"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveSheet.Previous.Range("C12").Value
ActiveCell.Offset(1, -1).Select
End If
End If
End If
If Not IsEmpty(ActiveCell) Then
ActiveCell.Offset(1, 0).Select
End If
If Not Worksheets("Fijos") Is Nothing Then
For Each c In Worksheets("Fijos").Range("A2:A40").Cells
If Not c Is Nothing Then
If Not IsEmpty(c.Offset(0, 1)) And Not c.Offset(0, 1) Is Nothing Then
If IsEmpty(c.Offset(0, 2)) And Not c.Offset(0, 2) Is Nothing Then
ActiveCell.Text = c.Text
ActiveCell.Offset(0, 1).Value = c.Offset(0, 1).Value
ActiveCell.Offset(1, 0).Select
ElseIf Not c.Offset(0, 2) Is Nothing And c.Offset(0, 2).Value > 0 Then
ActiveCell.Text = c.Text
ActiveCell.Offset(0, 1).Value = c.Offset(0, 1).Value
c.Offset(0, 2).Value = c.Offset(0, 2).Value - 1
ActiveCell.Offset(1, 0).Select
End If
End If
End If
Next
End If
End Sub
My worksheet "Fijos" is where I have my fixed expenses. On column A I have the descriptions, on column B I have the amount to be payed, and on column C I have the pending payments.
The idea is that I run along the A column, check the B and C column and, if there's an amount to pay on column B and pending payments (or empty) on C, I add the amount of B on my ActiveSheet.
On my ActiveSheet, column J is the description of the expenses and column K is the amount.
Whenever I execute the Macro, it says "Object Required" but doesn't say which line the error occurred at.
Any ideas? I only started trying out VBA a few days ago and it's probably a newbie mistake.
This line throw an error
ActiveCell.Text = "Tarjeta de Credito"
The text property is read only. It returns the display text of the cell not the cells value.
Use:
ActiveCell.Value = "Tarjeta de Credito"
I refactored your code removing any conditions that couldn't fail and combining the other if statements when possible.
Sub CargarFijos()
ActiveSheet.Range("J4").Activate
If Not IsEmpty(ActiveSheet.Previous.Range("C12")) Then
ActiveCell.Value = "Tarjeta de Credito"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveSheet.Previous.Range("C12").Value
ActiveCell.Offset(1, -1).Select
End If
If Not IsEmpty(ActiveCell) Then ActiveCell.Offset(1, 0).Select
For Each c In Worksheets("Fijos").Range("A2:A40").Cells
If Not IsEmpty(c.Offset(0, 1)) And IsEmpty(c.Offset(0, 2)) Then
ActiveCell.Value = c.Text
ActiveCell.Offset(0, 1).Value = c.Offset(0, 1).Value
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Value = c.Text
ActiveCell.Offset(0, 1).Value = c.Offset(0, 1).Value
c.Offset(0, 2).Value = c.Offset(0, 2).Value - 1
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub
Nothing is wrong with your code
If Not Worksheets("Fijos") Is Nothing Then
Worksheets("Fijos") cannot = Nothing because when you reference an non-existing member of a collection Error #9 Subscript out of range is thrown.
c.Offset(0, 1) Is Nothing
c.Offset(0, x) will never = Nothing either.
if x > MaxIndexValue: the overflow error is raised
if x < 0: the Application-defined or object-defined error is raised
Update
It's not throwing errors because Worksheets("Fijos") exists and c.Offset(0, 2) is never out of range.
Worksheets is a collection of objects not a single object. Collections use {Key, Value} pairs to store Objects or values. Keys are unique. I you try to add the same key twice to a collection it will throw an error. If you try to retrieve a value for a collection, it will throw an error. Knowing that let's step throw the line of code.
If Not Worksheets("Fijos") Is Nothing Then
- If: If what? Let's compare stuff
- Compare what?
- Not
- Not what?
- Worksheets("Non Existing Key")
- What is Worksheets("Non Existing Key")
- It's a value stored in Worksheets -> Worksheet collection
- What is the value of Worksheets("Non Existing Key")?
- At this point the [in Worksheets -> Worksheet collection] throws the #9 Subscript out of range error.
- Execution stops.
- The second part of the comparison is never reached
- Is Nothing is never evaluated
If you need to know if an item exists in a collection you have to trap the Subscript out of range error.
Function hasWorkBook(WorkbookName As String)
On Error Resume Next
Call Workbooks(WorkbookName).Name
If Err.Number <> 0 Then
hasWorkBook = False
Else
hasWorkBook = True
End If
On Error GoTo 0
End Function
Function hasWorkSheet(xlWorkbook As Workbook, SheetName As String)
On Error Resume Next
Call xlWorkbook.Worksheets(SheetName).Name
If Err.Number <> 0 Then
hasWorkSheet = False
Else
hasWorkSheet = True
End If
On Error GoTo 0
End Function
I am creating a client register where clients can be added using a button. I also have a sort function that allows me to sort them on klantnr. But the problem is whenever I use the sort function it only sorts klantnr and the added information provided from the form keeps in place. For example, this is my userform:
(http://puu.sh/cw94k/ebf4510a24.png)
And this is my excel sheet:
(http://puu.sh/cw9nc/3a8e19a989.png)
When I add another row it sorts klantnr but it doesn't take the other values, such as Naam and Adres with it. So it needs to sort klantnr and take the other information with it
This is my code:
Private Sub btn_Toevoegen_Click()
Dim laatsteKlantNummer As Integer
Range("B4:B13").End(xlDown).Select
laatsteKlantNummer = ActiveCell.Value
ActiveCell.Offset(1, 0).Value = txtKlant + 0
ActiveCell.Offset(1, 1).Value = txtNaam
ActiveCell.Offset(1, 2).Value = txtAdres
ActiveCell.Offset(1, 3).Value = txtWoonplaats
ActiveCell.Offset(1, 4).Value = txtContact
Me.Hide
Range("B4:B13").Sort Key1:=Range("B4:B13"), Order1:=xlAscending
End Sub
use the Sort object of the sheet instead of the one from the range object:
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("B4")
ActiveSheet.Sort.SetRange Range("B4:F13")
ActiveSheet.Sort.Apply
There you can use the SetRange method to define not only the key column but also the others you want to have sortet