I have a set of code that looks something like this, where I am searching row 1 for a specific word and want to return the column number where it is found:
Dim MyRng As Range
Dim MySht As Worksheet
Set MySht = ThisWorkbook.Sheets("Numbers")
Set MyRng = MySht.Rows(1).Find("Header 3" etc...)
FindSeriesColumn = MyRng.Column
It seems logical that I should be able to eliminate the need for defining a worksheet object and should be able to do the following:
Dim MyRng As Range
Set MyRng = ThisWorkbook.Sheets("Numbers").Rows(1).Find("Header 3" etc...)
FindSeriesColumn = MyRng.Column
However, the Set MyRng ... line results in an error. What is improper about using ThisWorkbook.Sheets("Sheet Name").Rows(1).Find...?
Use this form:
Sub fhksadf()
Dim MyRng As Range
Set MyRng = ThisWorkbook.Sheets("Numbers").Rows(1).Find(what:="Header 3")
FindSeriesColumn = MyRng.Column
MsgBox FindSeriesColumn
End Sub
EDIT#1:
It is easier to define the range being examined, and start the Find() after the beginning of that range:
Sub fhksadf()
Dim MyRng As Range
Dim temp As Range
Set temp = ThisWorkbook.Sheets("Numbers").Rows(1).Cells
Set MyRng = temp.Find(what:="Header 3", After:=temp(1))
FindSeriesColumn = MyRng.Column
MsgBox FindSeriesColumn
End Sub
Related
I have data on sheet A and want to duplicate it on sheet B. Because it is a lot of data, I do not want to use copy-paste. If I really simplify it, this is my code. My ranges change although I made it sort of fixed in this simplified code. I do not want to use something like range("A1:BBB100000") since my range will change. I get 1004 error "Application-defined or object-defined error". What am I doing wrong?
Dim origin(1 to 100000, 1 to 100000) as Variant
Dim dest(1 to 100000, 1 to 100000) as Variant
Set A=Worksheets("A")
Set B=Worksheets("B")
Vrow=100000
set origin=A.range(cells(1,1),cells(Vrow, Vrow))
set dest=B.range(cells(1,1),cells(Vrow, Vrow))
dest=origin
You don't need the array. Only generate an array if your actually going to do any calculations on it. If you just want to do value -> value then that's what you do (as shown below).
Remember to always declare all your variables as well.
Dim A As Worksheet, B As Worksheet, Vrow As Long
Set A = Worksheets("A")
Set B = Worksheets("B")
Vrow = 100000
B.Range(B.Cells(1, 1), B.Cells(Vrow, Vrow)).Value = A.Range(A.Cells(1, 1), A.Cells(Vrow, Vrow)).Value
Copy Range Values to Another Worksheet
Sub CopyValues()
Const sName As String = "A"
Const sFirstCellAddress As String = "A1"
Const dName As String = "B"
Const dFirstCellAddress As String = "A1"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim sfCell As Range: Set sfCell = sws.Range(sFirstCellAddress)
Dim srg As Range: Set srg = sfCell.CurrentRegion
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dfCell As Range: Set dfCell = dws.Range(dFirstCellAddress)
Dim drg As Range: Set drg = dfCell.Resize(srg.Rows.Count, srg.Columns.Count)
drg.Value = srg.Value
End Sub
Sub CopyValuesShorter()
Dim srg As Range
Set srg = ThisWorkbook.Worksheets("A").Range("A1").CurrentRegion
Dim drg As Range
Set drg = ThisWorkbook.Worksheets("B").Range("A1") _
.Resize(srg.Rows.Count, srg.Columns.Count)
drg.Value = srg.Value
End Sub
Sub CopyValuesShortest()
With ThisWorkbook.Worksheets("A").Range("A1").CurrentRegion
ThisWorkbook.Worksheets("B").Range("A1") _
.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End Sub
Take a look at the code below. When I add a new table object (ListObject) to my worksheet I would like to check if the specified range doesn't overlap another existing table. Can this be easily done, or do I need to iterate through all existing tables and verify their range coordinates?
Sub TableTest()
Dim TableObj As ListObject
Dim WS As Worksheet
Set WS = ActiveSheet
' How can I check if the range isn't overlapping another table before adding it?
Set TableObj = WS.ListObjects.Add(xlSrcRange, Range("C5:F8"))
End Sub
The code above will raise an error if there is an overlapping table object in the worksheet (e.g. at range A1:D6).
Something like this, checking the known range and the new range with Intersect():
Sub TableTest()
Dim TableObj As ListObject
Dim WS As Worksheet
Set WS = ActiveSheet
With WS
If Intersect(.Range("C5:F8"), .Range("C1")) Is Nothing Then
Set TableObj = WS.ListObjects.Add(xlSrcRange, .Range("C5:F8"))
Else
Debug.Print "They are intersecting"
End If
End With
End Sub
If you want to make the code a bit more flexible, with no predefined ranges for the tables, you may check for the intersect of the range of all tables and the new range:
Sub TestMe()
Dim tableObj As ListObject
Dim ws As Worksheet
Dim checkRange As Range
Set ws = ActiveSheet
With ws
For Each tableObj In ws.ListObjects
If checkRange Is Nothing Then
Set checkRange = tableObj.Range
Else
Set checkRange = Union(checkRange, tableObj.Range)
End If
Next tableObj
If Intersect(.Range("C5:F8"), checkRange) Is Nothing Then
Set tableObj = ws.ListObjects.Add(xlSrcRange, .Range("C5:F8"))
Else
Debug.Print "They are intersecting!"
End If
End With
End Sub
In the code above checkRange is the range, which unites all the ranges, over which there is a table.
I want some code that will search a worksheet for comments and return the address of a cell containing a particular comment.
Here's what I have so far:
Public Sub CommentLocator()
Dim Sht As Worksheet
Dim cmt As Comment
Dim StartCell As Variant
Set Sht = Sheet06
For Each cmt In Sht.Comments
If cmt.Text = "$StartCell" Then
Set StartCell = Range(cmt.Parent.Address)
Debug.Print cmt.Parent.Address
End If
Next cmt
End Sub
The problem is that this sets my variable StartCell to the value contained within the cell. But, I want it instead to return the address of the cell.
I've tried getting rid of the Range, but this results in a "Run-time error 13: Type mismatch".
I've tried adding .Address after the Range or the Range(cmt.Parent.Address), but this results in a "Compile Error: Argument not optional" or a "Compile Error: Object required".
I feel like I'm close, but can't quite get this to work on my own.
I'd really appreciate any help anyone can give me here. Thanks.
Don't use the Range() there:
Set StartCell = cmt.Parent
As a String:
Startcell = cmt.Parent.Address
Personally, I would favor storing the range object itself rather than the address. But if you want the described solution, this will work:
Public Sub CommentLocator()
Dim Sht As Worksheet
Dim cmt As Comment
Dim StartCell As Variant
Set Sht = Worksheets("Sheet06")
For Each cmt In Sht.Comments
If cmt.Text = "$StartCell" Then
StartCell = CStr(cmt.Parent.Address) ' <-- cmt.Parent is already a range object, no need for anything else. You can't use the Set keyword, though.
Debug.Print StartCell
End If
Next cmt
End Sub
To store the range object instead, change to:
Public Sub CommentLocator()
Dim Sht As Worksheet
Dim cmt As Comment
Dim StartCell As Range
Set Sht = Worksheets("Sheet06")
For Each cmt In Sht.Comments
If cmt.Text = "$StartCell" Then
Set StartCell = cmt.Parent
Debug.Print StartCell.Address
End If
Next cmt
End Sub
I have a sheet, let's call it sheetA. I have a range of fields in that sheet (rangeA) which has formulas that determine two more ranges in the same sheet. Let's call them rangeB and rangeC. Once these are determined, I want to copy rangeB and rangeC into sheets sheetB and sheetC respectively. Once that is done, I would like to delete rangeA. A reset of sorts so that I can enter new values in that range manually and repeat the process.
I want to have a function/button that can accomplish this. I have tried the following:
Private Sub TransferPuzzleButton1_Click()
FirstOperation
GetFirstEmptyCell1 "sht As Worksheet", "row As Long"
SecondOperation
GetFirstEmptyCell1 "sht As Worksheet", "row As Long"
ClearCell
End Sub
Sub FirstOperation()
Dim sourceSht As Worksheet: Set sourceSht = ThisWorkbook.Worksheets(1)
Dim destSht As Worksheet: Set destSht = ThisWorkbook.Worksheets(2)
GetFirstEmptyCell(destSht, 1).Resize(25).Value = sourceSht.Range("A1:A27").Value
End Sub
Function GetFirstEmptyCell1(sht As Worksheet, row As Long) As Range
Set GetFirstEmptyCell = sht.Cells(1, sht.Columns.Count).End(xlToLeft)
If Not IsEmpty(GetFirstEmptyCell) Then Set GetFirstEmptyCell = GetFirstEmptyCell.Offset(, 1)
End Function
Sub SecondOperation()
Dim sourceSht As Worksheet: Set sourceSht = ThisWorkbook.Worksheets(1)
Dim destSht As Worksheet: Set destSht = ThisWorkbook.Worksheets(3)
GetFirstEmptyCell(destSht, 1).Resize(2).Value = sourceSht.Range("C1:C2").Value
End Sub
Function GetFirstEmptyCell2(sht As Worksheet, row As Long) As Range
Set GetFirstEmptyCell = sht.Cells(1, 2).End(xlToLeft) '
If Not IsEmpty(GetFirstEmptyCell) Then Set GetFirstEmptyCell = GetFirstEmptyCell.Offset(, 1)
End Function
Sub ClearCell()
Dim sourceSht As Worksheet: Set sourceSht = ThisWorkbook.Worksheets(1)
sourceSht.Range("F7:I10").Clear
sourceSht.Range("C1:C2").Clear
End Sub
It seems I'm mangling the beginning Sub calls somehow
With GetFirstEmptyCell1 "sht As Worksheet", "row As Long" you are trying to call a sub that takes arguments. The argument typing is done in the definition of the sub, not in the statement that calls the sub.
When you call the sub you need to supply the parameters that it expects, in this case a worksheet and a long.
So, get your data ready before you call the sub. Abbreviated:
Private Sub TransferPuzzleButton1_Click()
Dim mySheet As Worksheet
dim myNumber as Long
Set mySheet = ThisWorkbook.Worksheets("DemoSheet")
MyNumber = 1000
' now call the function
GetFirstEmptyCell1 mySheet, myNumber
End Sub
Function GetFirstEmptyCell1(sht As Worksheet, row As Long) As Range
Set GetFirstEmptyCell = sht.Cells(1, sht.Columns.Count).End(xlToLeft)
If Not IsEmpty(GetFirstEmptyCell) Then Set GetFirstEmptyCell = GetFirstEmptyCell.Offset(, 1)
End Function
By the way, the names you use inside the function are not consistent. GetFirstEmptyCell1 vs GetFirstEmptyCell.
My requirement is to copy rows from sheet3 having font color black to sheet1.I have a range of rows selected from sheet3 in a workbook. I want to copy this and paste in sheet1.Selection part is ok, but Error (Application defined or object defined ) in copy statement.
Sub Copy()
Dim lastRow, i As Long
Dim CopyRange As Range
lastRow = Sheet3.Rows.Count
With Sheets(Sheet3.Name)
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To lastRow
If .Rows(i).Font.Color = 0 Then
If CopyRange Is Nothing Then
Set CopyRange = .Rows(i)
Else
Set CopyRange = Union(CopyRange, .Rows(i))
End If
End If
Next
End With
CopyRnge.Copy Destination:=Worksheets("Sheet1").Range("A1:J300")
End Sub
Option Explicit forces you to declare ALL the variables you use.
CopyRnge.Copy didn't exist when you ran the program, so Excel showed a run-time error.
Common errors like these can be avoided by turning on Option Explicit by default.
How to enable Option Explicit for all modules in VBA:
Suggested Code To Try:
The code below uses Option Explicit and it also takes advantages of using Object References.
By setting up Object References, you can rely on Intellisense to ensure you avoid typos.
Option Explicit
Sub CopyBlackText()
Dim lastRow As Long
Dim i As Long
Dim srcRangeToCopy As Range
Dim destinationRange As Range
Dim wrkbook As Workbook
'Setup Object references by assigning and using the 'Set' keyword
Set wrkbook = ActiveWorkbook
Set destinationRange = wrkbook.Worksheets("Sheet1").Range("A1:J300")
With wrkbook.Worksheets("Sheet3")
'Using Cells(1,1).Address instead of saying Range("A1")
lastRow = .Range(Cells(1, 1).Address).End(xlDown).Row
For i = 1 To lastRow
If .Rows(i).Font.Color = 0 Then
If srcRangeToCopy Is Nothing Then
Set srcRangeToCopy = .Rows(i)
Else
Set srcRangeToCopy = Union(srcRangeToCopy, .Rows(i))
End If
End If
Next
End With
srcRangeToCopy.Copy Destination:=destinationRange
End Sub