When I click on the add command button by default it's adding in the third row of the sheet. It should be added to the first available row. Is it something i need to change in the VBA code or the Button Properties?
Private Sub CmdAdd_Click()
Dim wks As Worksheet
Dim AddNew As Range
Set wks = Sheet1
Set AddNew = wks.Range("AA1000000").End(xlup).Offset(1, 0)
AddNew.Offset(0, 0).Value = txtcustomerid.Text
AddNew.Offset(0, 1).Value = txtContract.Text
AddNew.Offset(0, 2).Value = txtContractLBS.Text
AddNew.Offset(0, 3).Value = txtContractPrice.Text
AddNew.Offset(0, 4).Value = txtItem.Text
AddNew.Offset(0, 5).Value = Txtitemnum.Text
AddNew.Offset(0, 6).Value = TxtCustomerName.Text
AddNew.Offset(0, 7).Value = Txtstartdate.Text
AddNew.Offset(0, 8).Value = Txtenddate.Text
AddNew.Offset(0, 9).Value = TxtSalesPerson.Text
AddNew.Offset(0, 10).Value = TxtBroker.Text
AddNew.Offset(0, 11).Value = TxtTerms.Text
End Sub
Consider using ActiveSheet.UsedRange, see:
https://www.thespreadsheetguru.com/blog/2014/7/7/5-different-ways-to-find-the-last-row-or-last-column-using-vba
I suspect your current issue is due presence of formatting data, or lack of data in column AA - that may be a typo in your code?
Related
I think this is an easy one...
I have some code that goes through a source xls file and based on the company name it will pull out sales data relevant to that company and populate it in the company's own file.
It works fine (probably not very elegant), but I want to have a condition that only returns a value in one of my columns if a condition is met.
It's the commented line in the code below - any help greatly appreciated
For i = 2 To LastRow
If SourceSheet.Cells(i, 21).Value Like "CompanyName goes here*" Then
'change the column numbers to the relevant number
Product = SourceSheet.Cells(i, 11).Value
Base Sales Value = SourceSheet.Cells(i, 27).Value
Partner = SourceSheet.Cells(i, 21).Value
EndUser = SourceSheet.Cells(i, 7).Value
License = SourceSheet.Cells(i, 13).Value
PostingMonth = SourceSheet.Cells(i, 3).Value
LicType = SourceSheet.Cells(i, 12).Value
newuplift = SourceSheet.Cells(i, 15).Value
UpliftValue = SourceSheet.Cells(i, 28).Value
erow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'change the column numbers to the relevant number
DestSheet.Cells(erow, 1).Value = ProdType
DestSheet.Cells(erow, 2).Value = License
DestSheet.Cells(erow, 3).Value = Partner
DestSheet.Cells(erow, 4).Value = EndUser
DestSheet.Cells(erow, 5).Value = SOValue
DestSheet.Cells(erow, 6).Value = PostingMonth
DestSheet.Cells(erow, 7).Value = newuplift
DestSheet.Cells(erow, 8).Value = LicType
DestSheet.Cells(erow, 9).Value = UpliftValue 'TRYING TO PLACE A CONDITION HERE - SEE BELOW
' If newuplift = "Renewal" then place the Upliftvalue in row 9, otherwise set to "0"
End If
Next i
You could use IIf()
DestSheet.Cells(erow, 9).Value = IIf(newuplift = "Renewal", UpliftValue, 0)
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 am getting a runtime error 424 in my VBA code while trying to display records. It does not seem to be acknowledging lst.Display.ColumnCount and lst.Display.RowSource. Would very much appreciate the help to mitigate the issue. Every time I run the code, it shows me the 424 runtime error message pointing to the lstDisplay.ColumnCount and lstDisplay.RowSource lines.
Private Sub CommandButton1_Click()
Dim wks As Worksheet
Dim AddNew As Range
Set wks = Sheet1
Set AddNew = wks.Range("A65356").End(xlUp).Offset(1, 0)
AddNew.Offset(0, 0).Value = TextBox1.Text
AddNew.Offset(0, 1).Value = TextBox2.Text
AddNew.Offset(0, 2).Value = TextBox3.Text
AddNew.Offset(0, 3).Value = TextBox4.Text
AddNew.Offset(0, 4).Value = TextBox5.Text
AddNew.Offset(0, 5).Value = TextBox6.Text
AddNew.Offset(0, 6).Value = TextBox7.Text
AddNew.Offset(0, 7).Value = TextBox8.Text
AddNew.Offset(0, 8).Value = TextBox9.Text
AddNew.Offset(0, 9).Value = TextBox10.Text
lstDisplay.ColumnCount = 10
lstDisplay.RowSource = "B1: J65356"**
End Sub
Private Sub CommandButton2_Click()
TextBox1.Text = ""
TextBox2.Text = ""
End Sub
Private Sub CommandButton3_Click()
Dim i As Integer
For i = 0 To Range("A65356").End(xlUp).Row - 1
If lstDisplay.Selected(i) Then
Rows(i + 1).Select
Selection.Delete
End If
Next i
End Sub
I expect a list to be displayed in my form but it keeps on showing the error.
I am trying to create a way to automate a comparison and it almost works.I have a macro set to highlight all of the changes between the two sheets and paste them into a third. The problem that I am having is when it is writing the identified cells the macro fails when it has to record a macro that has blank spaces. I get a Run-time error '13': Type mismatch and when I run the debugger it always highlights this line of code
If Not cells.Value = ActiveWorkbook.Worksheets("Previous").cells(cells.Row, cells.Column).Value Then
cells.Interior.color = vbGreen
I have noticed that I receive the Run-time error '13': Type mismatch when the macro gets to a record that is blank or has blank spaces.
Sub CompareSheets()
Dim cells As range
'Adds a "Changes" sheet
Sheets.Add.Name = "Changes"
'Highlights the changes on the new data
For Each cells In ActiveWorkbook.Worksheets("Current").UsedRange
If Not cells.Value = ActiveWorkbook.Worksheets("Previous").cells(cells.Row, cells.Column).Value Then
cells.Interior.color = vbGreen
'Copies the cells with changes and brings them to the "Changes" sheet before highlighting them
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, cells.Column).Value = cells.Value
cells.copy
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, cells.Column).PasteSpecial Paste:=xlPasteFormats
'Copies the rows which have changes in them to the "Changes" sheet
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 1).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 1).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 2).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 2).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 3).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 3).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 4).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 4).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 5).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 5).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 6).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 6).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 7).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 7).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 8).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 8).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 9).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 9).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 10).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 10).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 11).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 11).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 12).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 12).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 13).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 13).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 14).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 14).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 15).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 15).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 16).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 16).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 17).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 17).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 18).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 18).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 19).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 19).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 20).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 20).Value
ActiveWorkbook.Worksheets("Changes").cells(cells.Row, 21).Value = ActiveWorkbook.Worksheets("Current").cells(cells.Row, 21).Value
End If
Next
Dim i As Long
'Delete blank rows on "Changes"
For i = ActiveWorkbook.Worksheets("Changes").UsedRange.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(ActiveWorkbook.Worksheets("Changes").UsedRange.Rows(i)) = 0 Then
ActiveWorkbook.Worksheets("Changes").UsedRange.Rows(i).EntireRow.Delete
End If
Next i
End Sub
I attempted to mimic your code and was getting an immediate flag on For Each cells In ActiveWorkbook.Worksheets("Current").UsedRange, so I needed to set the range to work in.
After that, I was getting error 9, subscript out of range, so I swapped your use of Cells to just cell and was able to get this code to work:
Option Explicit
Sub fdsa()
Dim cell As Range, ur As Range
Set ur = Sheets(1).UsedRange
For Each cell In ur
Debug.Print cell.Value
If Not cell.Value = Sheets(2).Cells(cell.Row, cell.Column).Value Then
cell.Interior.Color = vbGreen
End If
Next
End Sub
My sheets were simple, but looked like (after the code ran):
Sheets(1), current:
Sheets(2), previous:
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.