Unknown error in Excel VBA Macro code

Question

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

Does it throw an error message or just stop copying? – Darren Bartrup-Cook Mar 14 '18 at 17:24 — Darren Bartrup-Cook, Mar 14 '18 at 17:24

Vityata · Answer 1 · 2018-03-14T17:26:37.150

"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

Can you write **this is really not advisable** in bold 48 point type in red, underlined, italics and flashing if possible. :) — Darren Bartrup-Cook, Mar 14 '18 at 17:26

score 0 · Answer 2 · answered Mar 14 '18 at 17:30

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)

Darren Bartrup-Cook · Answer 3 · 2018-03-15T09:03:24.363

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.

Unknown error in Excel VBA Macro code

3 Answers3