I have the following code to generate Auto Serial Number in Column B and start from B15. It also depends upon Column C cells data records. when the C column cell will go empty at any point then the serial number will stop automatically in Column B.
Sub AutoSRIn()
Dim ws As Worksheet
Set ws = Sheet9
ws.Range("B15").Select
lrow = ws.Cells(Rows.Count, 3).End(xlUp).Row
Set myrange = ws.Range(Cells(15, 3), Cells(lrow, 3))
For Each cell In myrange
cell.Offset(0, -1).Value = i + 1
i = i + 1
Next cell
End Sub
But I am getting an error 'run time error 1004 range of object _worksheet failed at following line number'.
Set myrange = ws.Range(Cells(15, 3), Cells(lrow, 3))
The important and strange thing is that sometimes it works but if used in any other version like excel 2010 it is not working
I am trying to get a result through userform submit button. First, there is code for insert records in C column from C15 then Use this code to get the auto serial number for records.
Please Help Many thanks in advance!
Cells() without a worksheet qualifier will default to the active sheet, so
Set myrange = ws.Range(Cells(15, 3), Cells(lrow, 3))
will fail if ws is not the active sheet.
You need something like:
Set myrange = ws.Range(ws.Cells(15, 3), ws.Cells(lrow, 3))
You could shorten the above code to
Sub AutoSRIn()
With Sheet9
lrow = .Cells(.Rows.Count, 3).End(xlUp).Row
Set myrange = .Range(.Cells(15, 3), .Cells(lrow, 3))
End With
For Each cell In myrange
cell.Offset(0, -1).Value = i + 1
i = i + 1
Next cell
End Sub
Others have mentioned the explicit/implicit sheet reference issues. But you still make use of an iteration through range objects (not bad in itself, but not necessary and slow on a large range).
Alternatively try:
Sub AutoSRIn()
With Sheet9
Dim lr As Long: lr = .Cells(.Rows.Count, 3).End(xlUp).Row
If lr > 14 Then .Range("B15:B" & lr) = .Evaluate("ROW(1:" & lr - 14 & ")")
End With
End Sub
Btw, it's good practice to Dim all your variables to some Data type if possible (Dim myrange As Range and Dim i As Long for example)
Related
Ideally, what i need is to email the sepcified range rows with "x" in their column, i tried a code and it's working grand but the only problem is that it's sending 3 emails for 3 rows, but i want to send all the records in one email. I was able to do that using a vba code that converts the selected range in HTML and email it out. Now i want to automate the selection part.So basically i need to select the specified range of any row which have "x" in first column.
I tried a code but it's only selecting the last row that contains "x".
Link for the image showing what i am exactly looking for - https://imgur.com/a/Zq97ukL
Sub Button3_Click()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim Sheets As Worksheet
Dim r1 As Range
lRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lRow
If (Cells(i, 1)) = "x" Then 'change this range
Set r1 = Range(Cells(i, 2), Cells(i, 4))
r1.Select
On Error Resume Next
On Error GoTo 0
Cells(i, 10) = "Selected " & Date + Time 'column J
End If
Next i
ActiveWorkbook.Save
End Sub
jsheeran posted the bulk of this, but deleted his answer because it wasn't finished.
As previously stated, there is probably no reason to select anything.
Sub Button3_Click()
Dim lRow As Long
Dim i As Long
Dim toDate As Date
Dim Sheets As Worksheet
Dim r1 As Range
lRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lRow
If Cells(i, 1).Value = "x" Then
Set r1 = Union(IIf(r1 Is Nothing, Cells(i, 2).Resize(, 3), r1), Cells(i, 2).Resize(, 3))
Cells(i, 10).Value = "Selected " & Date + Time
End If
Next i
If Not r1 Is Nothing Then r1.Select
ActiveWorkbook.Save
End Sub
I have a worksheet (Sheet2) where there are pasted rows at Columns B:D at different row numbers.
These row numbers actually correspond with the row numbers in worksheet (Sheet1) which are blank and I wish to paste the cells dynamically into Columns C:E.
I have the following code which allows me to copy the row from Columns B:D based on a text value = "LAW" and paste in Sheet1 as long as I know the range of the cell in Column C.
I suppose what I am looking for is the equivalent of when "LAW" is found, match the row with the one in Sheet1 and paste at Column C. A loop is necessary as there are other instances where "LAW" is found and these cells need to be pasted at the appropriate cell range.
Dim WBT As Workbook
Dim WSD1 As Worksheet
Dim WSD2 As Worksheet
Set WBT = Workbooks("Invoices.csv")
Set WSD1 = WBT.Worksheets("Sheet1")
Set WSD2 = WBT.Worksheets("Sheet2")
Set r2 = WSD1.Range("C11")
With WSD2
N = .Cells(Rows.Count, "B").End(xlUp).row
For i = 1 To N
If .Cells(i, "B").Value = "LAW" Then
Set r1 = Range(.Cells(i, "B"), .Cells(N, "D"))
r1.Copy r2
End If
Next i
End With
I found it rather difficult to come up with a failsafe solution however, I hope someone can give me a few pointers as how I should go about this.
The example below demonstrates that I want to look for the rows in Sheet2 and paste them at the highlighted points in Sheet1. If there is a way of dynamically saying If Text in Column B on Sheet2 = LAW then copy that row (from Columns B to D) to the equivalent row in Sheet1. In my example I have two instances where this occurs.
Following the success of the amendment to the script by #SJR I then struck a problem where the Workbook had many many sheets. So I modified the code and used a function to test if a sheet exists (default is Not)
Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(sht)
On Error Resume Next
SheetExists = Not sht Is Nothing
End Function
and duplicated the code as follows:
Dim r1 As Range
Dim r2 As Range
Dim N As Long
Set r2 = WSD1.Range("C1:C100")
With WSD2
If Not SheetExists("Sheet1") Then
N = .Cells(Rows.Count, "B").End(xlUp).row
For i = 1 To N
If .Cells(i, "B").Value = "LAW" Then
Set r1 = Range(.Cells(i, "B"), .Cells(i, "D"))
r1.Copy WSD1.Cells(i, "C")
End If
Next i
Else
On Error Resume Next
End If
End With
With WSD3
If Not SheetExists("Sheet2") Then
N = .Cells(Rows.Count, "B").End(xlUp).row
For i = 1 To N
If .Cells(i, "B").Value = "LAW" Then
Set r1 = Range(.Cells(i, "B"), .Cells(i, "D"))
r1.Copy WSD1.Cells(i, "C")
End If
Next i
Else
On Error Resume Next
End If
End With
Although this works fine where the workbook has 2 sheets it falls over on the second script referencing WSD3 at N = .Cells(Rows.Count, "B").End(xlUp).rowwith run time error '91'. By stepping through the code I find that the variable for R1 comes up with the message if you hover over the Range???? Although I tried to figure out why it is saying the variable is not set I am confused.
Can you try this? Think you had an errant N in the line assigning r1.
Sub x()
Dim WBT As Workbook
Dim WSD1 As Worksheet
Dim WSD2 As Worksheet, N As Long
Set WBT = Workbooks("Invoices.csv")
Set WSD1 = WBT.Worksheets("Sheet1")
Set WSD2 = WBT.Worksheets("Sheet2")
Set r2 = WSD1.Range("C11")
With WSD2
N = .Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To N
If .Cells(i, "B").Value = "LAW" Then
Set r1 = .Range(.Cells(i, "B"), .Cells(i, "D"))
r1.Copy WSD1.Cells(i, "C")
End If
Next i
End With
End Sub
I would like to auto run below statements:
=VLOOKUP(B8,Sheet2!D:H,5,FALSE)
But I got an error at line 6: unable to get the VLookup property of the WorksheetFunction class
Sub Test()
Dim rng As Range
Dim i As Long
With ActiveSheet
Set rng = .Range("B8:D" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For i = 18 to rng.Rows.Count
rng.Cells(8, 6) =
Application.WorksheetFunction.VLookup(.Cells(i,1), Sheets("Sheet2").Range("D:H"), 5, False)
Next
End With
End Sub
Where I want to put my output at SheetT F8, by looking up Sheet2
I suspect you want
Sub Test()
Dim i As Long
With ActiveSheet
For i = 8 to .Cells(.Rows.Count, "B").End(xlUp).Row
.Cells(i, "F").Value = Application.VLookup(.Cells(i, "B").Value, _
Sheets("Sheet2").Range("D:H"), _
5, _
False)
Next
End With
End Sub
Your original code was:
always writing to rng.Cells(8, 6), which is a cell that was B8 offset by 7 rows and 5 columns, i.e. G15 (or C15 in an earlier version)
using ActiveSheet.Cells(i, 1) as the lookup value, which was a cell in column A
I have a row of dynamic column headers in the "Summary" tab and 111 worksheets appended at the end of the workbook, although this number is subject to change. I search for each column header in each appended worksheet and copy the cell immediately beneath any match to its corresponding column and row, a new row for each appended worksheet, in the "Summary" tab. The output meets my expectations. The time necessary to loop through every appended worksheet does not. Please let me know if there are obvious ways to optimize the code or more efficiently achieve my desired results. Thanks in advance.
Sub riasummary()
Dim riawksht As Worksheet
Dim consolwksht As Worksheet
Dim c As Integer
Dim r As Long
Dim sheader As Range
Dim sheaders As Range
Dim rheader As Range
Dim rheaders As Range
c = Sheets("Summary").Cells(1, Columns.Count).End(xlToLeft).Column
Set sheaders = Sheets("Summary").Range(Cells(1, 1), Cells(1, c))
For Each riawksht In ActiveWorkbook.Worksheets
If riawksht.Name <> "Summary" Then
Set rheaders = riawksht.Range("a5:xfd12")
For Each rheader In rheaders
For Each sheader In sheaders
r = Sheets("Summary").Cells(Rows.Count, "a").End(xlUp).Row
If rheader.Value = sheader.Value Then
rheader.Offset(1, 0).Copy
sheader.Offset(r, 0).PasteSpecial xlPasteAll
Application.CutCopyMode = False
'sheader.Offset(1, 0).Value = rheader.Offset(1, 0).Value
End If
Next
Next
End If
Next
End Sub
As a tangent, I also occasionally return an "Application-defined or object-defined error" at the following line of code that I cannot seem to decipher, and any insight here would be much appreciated as well.
Set sheaders = Sheets("Summary").Range(Cells(1, 1), Cells(1, c))
Set sheaders = Sheets("Summary").Range(Cells(1, 1), Cells(1, c))
Should be:
With Sheets("Summary")
Set sheaders = Sheets("Summary").Range(.Cells(1, 1), .Cells(1, c))
End With
You should always avoid unqualified Cells or Range calls, since they will default (in a regular module) to the active sheet.
I have a listbox on sheet1 with a list of sheetnames. When somebody double clicks on a name in the list, the code is supposed to activate that sheet, select some data and create a graph out of it.
The code is fine, right up until I ask it to define a range on the other sheet. I've had a number of different error messages and as best I can tell, the code is simply refusing to do anything that is not on sheet1. If somebody could explain why, that would be brilliant.
Code: the listbox is called Stocklist
Option Explicit
Sub StockList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call stockgraph
End Sub
Private Sub stockgraph()
Application.ScreenUpdating = False
Dim stockrange As Range
Dim daterange As Range
Dim security_name As String
Dim finalrow As Integer
Dim stockarray() As Double
Dim datearray() As String
Dim cell As Range
security_name = Empty
security_name = StockList.Value
If security_name = Empty Then MsgBox ("something's gone wrong, excel doesn't recognise that value") ' DEBUG
Worksheets(security_name).Activate ' --> this bit works fine
finalrow = ActiveSheet.Cells(1, 1).End(xlDown).row ' --> as does this
Set stockrange = Sheets(security_name).Range(Cells(2, 3), Cells(finalrow, 3))
' --> This gives a 1004 error, so does using activesheet
' --> if I don't reference a sheet, despite it not being the activesheet, the ranges are defined on sheet1
' --> and yet, the code was perfectly fine defining finalrow
Set daterange = Sheets(security_name).Range(Cells(2, 1), Cells(finalrow, 1))
ReDim stockarray(1 To finalrow - 1) As Double ' row 1 is a header so 2 to finalrow = 1 to finalrow-1
ReDim datearray(1 To finalrow - 1) As String
For Each cell In stockrange
stockarray(cell.row - 1) = cell.Value
Next cell
For Each cell In daterange
datearray(cell.row - 1) = cell.text
Next cell
Sheets("Top 10 holdings").Activate
' Create graph
Dim c As Chart
Dim s1 As Series
ActiveSheet.Cells(50, 50) = stockarray
ActiveSheet.Shapes.AddChart.Select
Set c = ActiveChart
Set s1 = c.SeriesCollection(1)
c.ChartType = xlLine
s1.Values = stockarray
Application.ScreenUpdating = True
End Sub
You cannot construct a cell range reference in that manner without fully qualifying the internal cell references used as demarcation points.
With Sheets(security_name)
finalrow = .Cells(1, 1).End(xlDown).row
Set stockrange = .Range(.Cells(2, 3), .Cells(finalrow, 3))
Set daterange = .Range(.Cells(2, 1), .Cells(finalrow, 1))
End With