I'm having an issue getting my loops correctly skip records. I have multiple records that need updating in a master from many slave workbooks. Each slave has a different name (of a it's user) and I need to make my "Update" loop more efficient by only comparing those records that contain the name of the User, then comparing the unique IDs, rather than what it currently does, which is compare all of the unique IDs to find a match.
My current command button simply looks for the users name in the column and if the count is higher than 0, it calls the module to update the records for that user.
In both Master and Slave column 1 is always the unique ID of the record and column 2 is always the user that the record is assigned to. Here is my current test coding (will become a template for other user's workbooks):
Option Explicit
Public Sub Agnes_Update()
Dim owb As Workbook
Dim Master, Slave As Worksheet
Dim fpath As String
Dim i, j As Integer
fpath = Application.ActiveWorkbook.Path & "\Agnes.xlsx"
Set owb = Application.Workbooks.Open(fpath)
Set Master = ThisWorkbook.Worksheets("Allocated")
Set Slave = owb.Worksheets("Work")
For j = 2 To 10 '(the master sheet)
For i = 2 To 10 '(the slave sheet)
'if ID cell is blank exit - ends loop when all updates are completed
If Trim(Slave.Cells(j, 1).Value2) = vbNullString Then Exit For
'if column 2 of master does not contain the current username being
'updated then move to next record
If Master.Cells(j, 2).Value = "Agnes" Then
'if unique ID in column 1 matches slave from master then begin
'updating of required cells
If Master.Cells(i, 1).Value2 = Slave.Cells(j, 1).Value2 Then
Master.Cells(i, 4).Value = Slave.Cells(j, 4).Value
Master.Cells(i, 5).Value = Slave.Cells(j, 5).Value
Master.Cells(i, 6).Value = Slave.Cells(j, 6).Value
Master.Cells(i, 7).Value = Slave.Cells(j, 7).Value
Master.Cells(i, 8).Value = Slave.Cells(j, 8).Value
Master.Cells(i, 9).Value = Slave.Cells(j, 9).Value
Master.Cells(i, 10).Value = Slave.Cells(j, 10).Value
Master.Cells(i, 11).Value = Slave.Cells(j, 11).Value
Master.Cells(i, 12).Value = Slave.Cells(j, 12).Value
Master.Cells(i, 13).Value = Slave.Cells(j, 13).Value
Master.Cells(i, 14).Value = Slave.Cells(j, 14).Value
Master.Cells(i, 15).Value = Slave.Cells(j, 15).Value
Master.Cells(i, 16).Value = Slave.Cells(j, 16).Value
Master.Cells(i, 17).Value = Slave.Cells(j, 17).Value
Master.Cells(i, 18).Value = Slave.Cells(j, 18).Value
Master.Cells(i, 19).Value = Slave.Cells(j, 19).Value
Master.Cells(i, 20).Value = Slave.Cells(j, 20).Value
Master.Cells(i, 21).Value = Slave.Cells(j, 21).Value
Master.Cells(i, 22).Value = Slave.Cells(j, 22).Value
Master.Cells(i, 23).Value = Slave.Cells(j, 23).Value
End If
End If
Next
Next
Workbooks("Agnes").Close
End Sub
I prefer to use the Master.cells = Slave.cells method as some of the slave cells are locked to prevent the user amending data, and in the future the position of some of the data may change columns, so I will simply amend which master column = which slave column. I realize I could set the code to unlock the workbook, but that is even more coding for a simple bit of updating.
I believe the current issue with the code lies in the line If Master.Cells(j, 2).Value = "Agnes" Then as removing this line allows the code to go through all the unique IDs to find and update the master on all matches, but i'd rather it only try to match unique IDs when the user name is found in column 2 to try and make the code quicker and more efficient.
Can anyone help correct this code for me please?
If I am understanding correctly, you need to move the test prior to the inner loop (I have made a couple of other small changes to reduce the amount of code and stop repetition)
Public Sub Agnes_Update()
Dim owb As Workbook
Dim wbname As String
Dim Master, Slave As Worksheet
Dim fpath As String
Dim i, j As Integer
fpath = Application.ActiveWorkbook.Path & "\Agnes.xlsx"
Set owb = Application.Workbooks.Open(fpath)
wbname = Left$(owb.Name, InStrRev(owb.Name, ".") - 1)
Set Master = ThisWorkbook.Worksheets("Allocated")
Set Slave = owb.Worksheets("Work")
For j = 2 To 10 '(the master sheet)
'if column 2 of master does not contain the current username being
'updated then move to next record
If Master.Cells(j, 2).Value = wbname Then
For i = 2 To 10 '(the slave sheet)
'if ID cell is blank exit - ends loop when all updates are completed
If Trim(Slave.Cells(j, 1).Value2) = vbNullString Then Exit For
'if unique ID in column 1 matches slave from master then begin
'updating of required cells
If Master.Cells(i, 1).Value2 = Slave.Cells(j, 1).Value2 Then
Slave.Cells(j, 4).Resize(, 20).Copy
Master.Cells(i, 4).PasteSpecial Paste:=xlPasteValues
End If
End If
Next
Next
owb.Close SaveChanges:=False
End Sub
Related
I am New to VBA, so my codes are usually very slow/suboptimized.
In one of my programs I have cells in the sheet that has to be filled when the user press a button, the renges change depending on the button but the concept is the same.
So I did this monstrosity:
Cells((Range("namedrange").Row + 5), 1).Value = ThisWorkbook.Sheets(5).Cells(4, 7).Value
Cells((Range("namedrange").Row + 5), 3).Value = ThisWorkbook.Sheets(5).Cells(4, 8).Value
Cells((Range("namedrange").Row + 5), 5).Value = ThisWorkbook.Sheets(5).Cells(4, 9).Value
Cells((Range("namedrange").Row + 5), 8).Value = ThisWorkbook.Sheets(5).Cells(4, 10).Value
Cells((Range("namedrange").Row + 5) + 1, 1).Value = ThisWorkbook.Sheets(5).Cells(5, 7).Value
Cells((Range("namedrange").Row + 5) + 1, 3).Value = ThisWorkbook.Sheets(5).Cells(5, 8).Value
Cells((Range("namedrange").Row + 5) + 1, 5).Value = ThisWorkbook.Sheets(5).Cells(5, 9).Value
Cells((Range("namedrange").Row + 5) + 1, 8).Value = ThisWorkbook.Sheets(5).Cells(5, 10).Value
but later changed to:
With Range("namedrange")
.Offset(5).Columns(1).Value = ThisWorkbook.Sheets(3).Cells(4, 7).Value
.Offset(5).Columns(3).Value = ThisWorkbook.Sheets(3).Cells(4, 8).Value
.Offset(5).Columns(5).Value = ThisWorkbook.Sheets(3).Cells(4, 9).Value
.Offset(5).Columns(8).Value = ThisWorkbook.Sheets(3).Cells(4, 10).Value
.Offset(6).Columns(1).Value = ThisWorkbook.Sheets(3).Cells(5, 7).Value
.Offset(6).Columns(3).Value = ThisWorkbook.Sheets(3).Cells(5, 8).Value
.Offset(6).Columns(5).Value = ThisWorkbook.Sheets(3).Cells(5, 9).Value
.Offset(6).Columns(8).Value = ThisWorkbook.Sheets(3).Cells(5, 10).Value
End With
which is a bit faster, however I feel that it is still suboptimized. And I would like to know if there is a way to make it cleaner/more elegant.
Just to be noted that there are discontinuities in the columns, e.g. it starts in the 1st columns but jumps to the 3rd and then to the 5th and at last to the 8th.
The code works but it is slow, I just want a way to make it faster/cleaner.
Using Variables
In regards to efficiency, that's about it: you're using the most efficient way to copy values from one cell to another aka copying by assignment.
If you want it to be more flexible, maintainable, and readable(?), here are some ideas.
Additionally, you can move the remaining magic numbers and text to constants at the beginning of the code or even use the constants as arguments.
Sub CopyValues()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Specify the worksheet if you know it.
'Dim dnrg As Range: Set dnrg = wb.Sheets("Sheet1").Range("NamedRange")
' Otherwise, make sure the workbook is active.
If Not wb Is ActiveWorkbook Then wb.Activate
Dim dnrg As Range: Set dnrg = Range("NamedRange")
Dim drg As Range: Set drg = dnrg.Range("A1,C1,E1,H1").Offset(5)
Dim cCount As Long: cCount = drg.Cells.Count
' If you know the tab name, use it instead of the index (3).
Dim sws As Worksheet: Set sws = wb.Sheets(3)
Dim srg As Range: Set srg = sws.Range("G4").Resize(, cCount)
Dim r As Long, c As Long
For r = 0 To 1
For c = 1 To cCount
drg.Offset(r).Cells(c).Value = srg.Offset(r).Cells(c).Value
Next c
Next r
End Sub
Accessing Excel for values from VBA is a slow operation and this adds up when you make multiple requests. When you are essentially retrieving the same information on a repetitive basis there are two two methods can be used to reduce access times.
Replace a lookup with a calculated value
Use a with statement
Thus you code could be written as
Dim myCol as long
myCol =Range("namedrange").Row + 5
With ThisWorkook.Sheets(5)
Cells(myCol, 1).Value = .Cells(4, 7).Value
Cells(myCol, 3).Value = .Cells(4, 8).Value
Cells(myCol, 5).Value = .Cells(4, 9).Value
Cells(myCol, 8).Value = .Cells(4, 10).Value
myCol=myCol+1 ' trivial example
Cells(mycol, 1).Value = .Cells(5, 7).Value
Cells(myCol, 3).Value = .Cells(5, 8).Value
Cells(myCol, 5).Value = .Cells(5, 9).Value
Cells(myCol, 8).Value = .Cells(5, 10).Value
End with
Please also install the free, opensource, and fantastic Rubberduck addin for VBA. The code inspections will help you write VBA that is much more correct.
I wonder what would happen if you use all the .Offset parameters, row and column. Example:
With Range("namedrange")
.Offset(5, 0).Value = ThisWorkbook.Sheets(3).Cells(4, 7).Value
.Offset(5, 2).Value = ThisWorkbook.Sheets(3).Cells(4, 8).Value
.Offset(5, 4).Value = ThisWorkbook.Sheets(3).Cells(4, 9).Value
.Offset(5, 7).Value = ThisWorkbook.Sheets(3).Cells(4, 10).Value
.Offset(6, 0).Value = ThisWorkbook.Sheets(3).Cells(5, 7).Value
.Offset(6, 2).Value = ThisWorkbook.Sheets(3).Cells(5, 8).Value
.Offset(6, 4).Value = ThisWorkbook.Sheets(3).Cells(5, 9).Value
.Offset(6, 7).Value = ThisWorkbook.Sheets(3).Cells(5, 10).Value
End With
You can try to disable screenupdating during execution.
Disable ScreenUpdating
To disable ScreenUpdating, at the beginning of your code put this line:
Application.ScreenUpdating = False
Enable ScreenUpdating
To re-enable ScreenUpdating, at the end of your code put this line:
Application.ScreenUpdating = True
I'm doing a Data Entry Table with a From using VBA. The code works fine, but it adds the entry to the first row after the table. For example, if the table's last row is row 20, then it will add the entry in row 21 outside of the table. Is there a way to assign the data to be added in the last row of the table?
This is the code I'm using to add the data to the table:
Private Sub buttonSave_Click()
If MsgBox("Deseas incluir este trabajo?", vbYesNo, "Guardar repuesto") = vbYes Then
'write the data to the worksheet from controls
Call WriteDataToSheet
'empty textboxes
Call EmptyTextBoxes
End If
End Sub
Private Sub WriteDataToSheet()
Dim newRow As Long
With Sheet1
newRow = .Cells(.Rows.Count, 2).End(xlUp).row + 1
.Cells(newRow, 1).Value = textboxNewDate.Value
.Cells(newRow, 2).Value = textboxNameNew.Value
.Cells(newRow, 3).Value = textboxNewEquipment.Value
.Cells(newRow, 4).Value = textboxNewTech.Value
.Cells(newRow, 5).Value = textboxNewCot.Value
.Cells(newRow, 6).Value = textboxNewPrice.Value
.Cells(newRow, 7).Value = textboxNewFac.Value
.Cells(newRow, 8).Value = textboxNewStatusF.Value
.Cells(newRow, 9).Value = textboxNewServ.Value
.Cells(newRow, 10).Value = textboxNewEnt.Value
.Cells(newRow, 11).Value = textboxNewDesc.Value
.Cells(newRow, 12).Value = textboxNewStatus.Value
End With
End Sub
This is the code I'm using to extract the range from the table. This is in a separate module.
Public Function GetType() As Variant
GetType = Sheet1.ListObjects("tbTabla2").DataBodyRange.Value
End Function
Is there a way I can assign the data to be added after the last row inside of "Tabla2".
This is the table for reference:
To keep your data inside the table, I suppose you would want to use the ListObject.ListRows.Add() method to add a new row. You could do something like this:
Private Sub WriteDataToTable()
Dim newTableRow As Range
newTableRow = Sheet1.ListObjects("Table2").ListRows.Add().Range
WriteDataToRow newTableRow
End Sub
Private Sub WriteDataToRow(row As Range)
Dim newRowNumber As Long
newRowNumber row.row
With Sheet1
.Cells(newRow, 1).Value = textboxNewDate.Value
.Cells(newRow, 2).Value = textboxNameNew.Value
.Cells(newRow, 3).Value = textboxNewEquipment.Value
.Cells(newRow, 4).Value = textboxNewTech.Value
.Cells(newRow, 5).Value = textboxNewCot.Value
.Cells(newRow, 6).Value = textboxNewPrice.Value
.Cells(newRow, 7).Value = textboxNewFac.Value
.Cells(newRow, 8).Value = textboxNewStatusF.Value
.Cells(newRow, 9).Value = textboxNewServ.Value
.Cells(newRow, 10).Value = textboxNewEnt.Value
.Cells(newRow, 11).Value = textboxNewDesc.Value
.Cells(newRow, 12).Value = textboxNewStatus.Value
End With
End Sub
Now, since you are using newRow = .Cells(.Rows.Count, 2).End(xlUp).row + 1 to find a last-used-row, that implies to me that you could be looking at a case were there is room in your table and you don't want to add a new row. In that case, you'll want to do some sort of conditional test to check if adding the new row is needed. Depending on how things are managed, I think its easier to just ensure the table always ends with the last used row so that you will ALWAYS be adding a row to the table when you want to add data.
I am a complete novice at Excel VBA and I am currently attempting a project on Excel VBA. I have created a UserForm that would allow the user to enter data onto the Excel Sheet by completing the fields in the UserForm. I have tested all the codes individually and they have worked fine.
For the user to access the UserForm, I have added an ActiveX Command Button on a separate sheet on the same workbook. However, when accessing the UserForm from the ActiveX Command Button, some of the codes do not run (mainly the code that flags out the duplicate entry, as well as the code that generates serial numbers).
Where did I go wrong in my code?
This is my code to adding new data as well as the code to flag out duplicate entries. When opening the UserForm from the ActiveX Command Button, adding new data works fine but it does not flag out duplicate entries in the data. (However, testing the code itself in VBA works perfectly fine).
Private Sub cmdAddNewCustomer_Click()
Dim count As Long
Dim lastrow As Long
Dim lCustomerID As String
Dim ws As Worksheet
Set ws = Worksheets("Customer Data")
'find first empty row in database
lrow = ws.Cells.Find(what:="*", searchorder:=xlRows, _
Searchdirection:=xlPrevious, LookIn:=xlValues).Row + 1
lCustomerID = txtCustomerID
count = 0
With ws
For currentrow = 1 To lrow
If lCustomerID = Cells(currentrow, 1) Then
count = count + 1
End If
If count > 1 Then
.Cells(currentrow, 1).Value = ""
.Cells(currentrow, 2).Value = ""
.Cells(currentrow, 3).Value = ""
.Cells(currentrow, 4).Value = ""
.Cells(currentrow, 5).Value = ""
.Cells(currentrow, 6).Value = ""
.Cells(currentrow, 7).Value = ""
.Cells(currentrow, 8).Value = ""
.Cells(currentrow, 9).Value = ""
.Cells(currentrow, 10).Value = ""
.Cells(currentrow, 11).Value = ""
.Cells(currentrow, 12).Value = ""
.Cells(currentrow, 13).Value = ""
.Cells(currentrow, 14).Value = ""
MsgBox ("CustomerID already exists!")
End If
If count = 0 Then
.Cells(lrow, 1).Value = Me.txtCustomerID.Value
.Cells(lrow, 2).Value = Me.txtCustomerName.Value
.Cells(lrow, 3).Value = Me.cboCustomerStatus.Value
.Cells(lrow, 4).Value = Me.txtContactPerson.Value
.Cells(lrow, 5).Value = Me.cboDepartment.Value
.Cells(lrow, 6).Value = Me.txtPosition.Value
.Cells(lrow, 7).Value = Me.cboRoleType.Value
.Cells(lrow, 8).Value = Me.txtofficeHP1.Value
.Cells(lrow, 9).Value = Me.txtOfficeHP2.Value
.Cells(lrow, 10).Value = Me.txtMobileHP1.Value
.Cells(lrow, 11).Value = Me.txtMobileHP2.Value
.Cells(lrow, 12).Value = Me.txtEmail1.Value
.Cells(lrow, 13).Value = Me.txtEmail2.Value
.Cells(lrow, 14).Value = Me.txtEmail3.Value
End If
Next currentrow
End With
'clear the data
Me.txtCustomerName.Value = ""
Me.cboCustomerStatus.Value = ""
Me.txtContactPerson.Value = ""
Me.cboDepartment.Value = ""
Me.txtPosition.Value = ""
Me.cboRoleType.Value = ""
Me.txtofficeHP1.Value = ""
Me.txtOfficeHP2.Value = ""
Me.txtMobileHP1.Value = ""
Me.txtMobileHP2.Value = ""
Me.txtEmail1.Value = ""
Me.txtEmail2.Value = ""
Me.txtEmail3.Value = ""
End Sub
This is the code to generate serial numbers. (Same problem, does not work when accessed via ActiveX Command Button but works fine when tested individually in VBA).
Sub FindCustomerID()
Dim lastrow
Dim lastnum As Long
Dim ws As Worksheet
Set ws = Worksheets("Customer Data")
If Me.cboCountry = "" Or Me.txtCustomerName = "" Then
Exit Sub
End If
serialno = 1
lastrow = ws.Cells(Rows.count, 1).End(xlUp).Row
CountryCode = UCase(Left(Me.cboCountry, 3))
CustomerCode = UCase(Left(Me.txtCustomerName, 10))
'assemble them into CustomerID
CustomerID = CountryCode & CustomerCode & serialno
For currentrow = 2 To lastrow
If CustomerID = Cells(currentrow, 1) Then
'find last number that applies
serialno = serialno + 1
End If
're-assign customerID with new serial number
CustomerID = CountryCode & CustomerCode & serialno
Next currentrow
Me.lblCustomerID = CustomerID
End Sub
And lastly, this is the code from the ActiveX Command Button that brings out the UserForm.
Private Sub cmdNCustomerData_Click()
frmCustomerdata.Show
End Sub
The cause of the problem you described is a missing . to qualify Cells(currentrow, 1). Because you added the ActiveX button to a different sheet, the line
If lCustomerID = Cells(currentrow, 1) Then
accesses Cells(currentrow, 1) of that sheet. To fix this the range needs to be qualified with a . to become
If lCustomerID = .Cells(currentrow, 1) Then
I would also take
If count = 0 Then
.
.
.
End If
outside the loop. You are repeating these lines many times unnecessarily.
The first block of code then becomes:
Private Sub cmdAddNewCustomer_Click()
Dim count As Long
Dim lastrow As Long
Dim lCustomerID As String
Dim ws As Worksheet
Set ws = Worksheets("Customer Data")
'find first empty row in database
lrow = ws.Cells.Find(what:="*", searchorder:=xlRows, _
Searchdirection:=xlPrevious, LookIn:=xlValues).Row + 1
lCustomerID = txtCustomerID
count = 0
With ws
' Count backward to delete rows completely
For currentrow = lrow - 1 To 1 Step -1
If lCustomerID = .Cells(currentrow, 1) Then
count = count + 1
End If
If count > 1 Then
.Cells(currentrow, 1).Resize(1, 14).ClearContents
' Uncomment the following line to delete the whole row completely
'.Rows(currentrow).Delete
End If
Next currentrow
If count > 1 Then
MsgBox (count - 1 " duplicates of CustomerID found and cleared!")
ElseIf count = 0 Then
.Cells(lrow, 1).Value = Me.txtCustomerID.Value
.Cells(lrow, 2).Value = Me.txtCustomerName.Value
.Cells(lrow, 3).Value = Me.cboCustomerStatus.Value
.Cells(lrow, 4).Value = Me.txtContactPerson.Value
.Cells(lrow, 5).Value = Me.cboDepartment.Value
.Cells(lrow, 6).Value = Me.txtPosition.Value
.Cells(lrow, 7).Value = Me.cboRoleType.Value
.Cells(lrow, 8).Value = Me.txtofficeHP1.Value
.Cells(lrow, 9).Value = Me.txtOfficeHP2.Value
.Cells(lrow, 10).Value = Me.txtMobileHP1.Value
.Cells(lrow, 11).Value = Me.txtMobileHP2.Value
.Cells(lrow, 12).Value = Me.txtEmail1.Value
.Cells(lrow, 13).Value = Me.txtEmail2.Value
.Cells(lrow, 14).Value = Me.txtEmail3.Value
End If
End With
'clear the data
Me.txtCustomerName.Value = ""
Me.cboCustomerStatus.Value = ""
Me.txtContactPerson.Value = ""
Me.cboDepartment.Value = ""
Me.txtPosition.Value = ""
Me.cboRoleType.Value = ""
Me.txtofficeHP1.Value = ""
Me.txtOfficeHP2.Value = ""
Me.txtMobileHP1.Value = ""
Me.txtMobileHP2.Value = ""
Me.txtEmail1.Value = ""
Me.txtEmail2.Value = ""
Me.txtEmail3.Value = ""
End Sub
In the FindCustomerID subroutine you have exactly the same problem with the line
If CustomerID = Cells(currentrow, 1) Then
as Cells(currentrow, 1) is not qualified and therefore, should become
If CustomerID = ws.Cells(currentrow, 1) Then
You are also reassigning the CustomerID many times unnecessarily. I would take the reassignment inside the If statement and the loop will become
For currentrow = 2 To lastrow
If CustomerID = ws.Cells(currentrow, 1) Then
'find last number that applies
serialno = serialno + 1
're-assign customerID with new serial number
CustomerID = CountryCode & CustomerCode & serialno
End If
Next currentrow
This way CustomerID is only reassigned if and only if serialno changes.
Trying to get text boxes to populate when a name is selected from my combo box (cboCo). Getting the error method range of object'_worksheet' failed on fourth line of code.
I am not a strong programmer and VB has always been a struggle for me. I am working on creating a form for a vendor spreadsheet that will allow users to view data in the spreadsheet, edit vendor data, add new data and delete data as needed. I so far have got it to add data and show the company names in the combo box. What I am working on currently is getting the text boxes to populate with the data in the row for the company selected in the combobox.
Private Sub cboCo_Change()
Dim iRow As Long, LastRow As Long, ws As Worksheet
Set ws = Worksheets("VendorInfo")
LastRow = ws.Range(1 & Rows.Count).End(x1Up).Row
For iRow = 2 To LastRow
If (Me.cboCo.Value) = ws.Cells(iRow, 1) Then
Me.cboCat = ws.Cells(iRow, 19).Value
Me.cboCat = ws.Cells(iRow, 19).Value
Me.cboYrApprv = ws.Cells(iRow, 14).Value
Me.txtContact = ws.Cells(iRow, 2).Value
Me.txtPhone = ws.Cells(iRow, 3).Value
Me.txtEmail = ws.Cells(iRow, 4).Value
Me.txtCoAdd = ws.Cells(iRow, 5).Value
Me.txtWebSite = ws.Cells(iRow, 6).Value
Me.txtAccred = ws.Cells(iRow, 8).Value
Me.txtStanding = ws.Cells(iRow, 9).Value
Me.txtSince = ws.Cells(iRow, 10).Value
Me.txtNotes = ws.Cells(iRow, 11).Value
Me.txtVerified = ws.Cells(iRow, 12).Value
Me.txtToday = ws.Cells(iRow, 13).Value
Me.txtServProd = ws.Cells(iRow, 7).Value
Me.txtApprvBy = ws.Cells(iRow, 15).Value
Me.txtAprvReas = ws.Cells(iRow, 16).Value
Me.txtOrder = ws.Cells(iRow, 17).Value
Me.txtPurchs = ws.Cells(iRow, 18).Value
End If
Next iRow
End Sub
When I select a company from my cboCo combo box I get the method range of object'_worksheet' failed error on the fourth Line (starting with LastRow just above my loop)
You are calling Range() incorrectly. Try this:
LastRow = ws.Cells(1, Rows.Count).End(xlUp).Row
or
LastRow = ws.Range("A" & rows.count).End(xlUp).Row
Originally, it was resolving to basically ws.Range(1 & 1048576)... --> ws.Range(11048576).End(xlUp).Row, which A) isn't a proper Range and B) is a non-existent row number.
Also, note it's xlUp, not x1Up (it's an "L", not a "1")
I am using the following code to enter data from Userform to Excel sheet and works fine.
The problem is that it overwrites the same row of data. But if I change:
.Cells(RowCount, 4).Value = Me.DepSectDrop.Value to contain a 1 --> .Cells(RowCount, 1).Value = Me.DepSectDrop.Value, and likewise for the rest (2 fore SiteFacOpen, 3 for CaseStartOpen, etc), it does not overwrite.
Private Sub cmdAdd_Click()
'Copy input values to sheet.
Dim RowCount As Long
Dim ws As Worksheet
Set ws = Worksheets("TRACK")
RowCount = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Cells(RowCount, 4).Value = Me.DepSectDrop.Value
.Cells(RowCount, 5).Value = Me.SiteFacOpen.Value
.Cells(RowCount, 6).Value = Me.CaseStartOpen.Value
.Cells(RowCount, 7).Value = Me.TypeDrop.Value
.Cells(RowCount, 8).Value = Me.ProcessDrop.Value
.Cells(RowCount, 9).Value = Me.CompNameOpen.Value
.Cells(RowCount, 10).Value = Me.CompEIDOpen.Value
.Cells(RowCount, 11).Value = Me.RespNameOpen.Value
.Cells(RowCount, 12).Value = Me.RespEIDOpen.Value
.Cells(RowCount, 13).Value = Me.DescOpen.Value
End With
'Clear input controls.
Me.DepSectDrop.Value = ""
Me.SiteFacOpen.Value = ""
Me.CaseStartOpen.Value = ""
Me.TypeDrop.Value = ""
Me.ProcessDrop.Value = ""
Me.CompNameOpen.Value = ""
Me.CompEIDOpen.Value = ""
Me.RespNameOpen.Value = ""
Me.RespEIDOpen.Value = ""
Me.DescOpen.Value = ""
End Sub
What do I need to do to so I maintain the right columns for it all to be entered, but not be overwritten? Thank you
You need to change all lines that start
.Cells(RowCount, 5).Value ...
To
.Cells(RowCount + 1, 5).Value
The '+1' bit means you're using the next blank line.
Also, as Samuel pointed out, you should also change to
RowCount = ws.Cells (Rows.Count, 4).End (xlUp).Offset (1,0).Row
so that you're testing a column that's guaranteed to have data in it!
Sorry, I missed the offset bit ... No need to '+1' if you're offsetting by 1 ... It amounts to the same thing.