I'm at a loss as to why it seems that I can store a range value in the range property of a worksheet variable but not in a range variable. I got error 91 every time I tried to run this code:
Dim ws As Worksheet, rng As Range
Set ws = Worksheets.Add
ws.name = "Potato"
rng = ws.Range("A1:K1")
rng.PasteSpecial
I was able to run the program successfully by replacing the last 2 lines with:
ws.Range("A1:K1").PasteSpecial
This works, even though it clutters other parts of my code. But I can't understand for the life of me what the problem was with using the range variable was.
I would appreciate any clarification anyone can provide.
You have to use Set with object variables:
Set rng = ws.Range("A1:K1")
Here is added code that will make sure there won't be an error if you already have a sheet named "Potato"
Code to make sure Sheet("Potato") doesn't already exist.
Sub Button1_Click()
Dim ws As Worksheet, rng As Range, cRng As Range
Dim worksh As Integer
Dim worksheetexists As Boolean
Dim s As String
s = "Potato"
Set cRng = ActiveSheet.Range("A1:K1")
worksh = Application.Sheets.Count
worksheetexists = False
For x = 1 To worksh
If Worksheets(x).Name = s Then
worksheetexists = True
MsgBox s & ", already Exists"
Exit For
End If
Next x
If worksheetexists = False Then
Set ws = Worksheets.Add()
ws.Name = s
Set rng = ws.Range("A1:K1")
cRng.Copy
rng.PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = 0
End If
End Sub
Related
I'm trying to create a new sheet labeled with a different identifier from a range and also have two cells from other ranges included on each update. I can get the new sheets to create with a different label from a range, and have the first cell in the second range (xRg2) added to each subsequent sheet, but haven't been successful at iterating through the second range. I know I need another loop somewhere but my last nest created way too many sheet. See example below
Sub Add()
Dim xRg As Excel.Range
Dim xRg2 As Excel.Range
Dim wSh As Excel.Worksheet
Dim wBk As Excel.Workbook
Dim wSh2 As Excel.Worksheet
Dim wSh3 As Excel.Worksheet
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
Set wSh2 = ThisWorkbook.Sheets("List")
Set wSh3 = ThisWorkbook.Sheets("Template")
Set xRg2 = wSh2.Range("G66:G88")
Application.ScreenUpdating = False
For Each xRg In wSh2.Range("B66:B88")
With wBk
wSh3.Copy after:=.Sheets(.Sheets.Count)
On Error Resume Next
wSh.Name = xRg.Value
wSh.Cells(33,7) = xRg2.Value
If Err.Number = 1004 Then
Debug.Print xRg.Value & "already used as a sheet name"
End If
On Error GoTo 0
End With
Next xRg
Application.ScreenUpdating = True End Sub
So, to summarize, the goal here is to input the ranges into the code each time and have each new sheet include the first values from each range, then the second sheet the second values from each range, and so on until the xRg is at the end of it's list. I know there's only two ranges down here but the total will be 3. Also apologies on the poor variable discipline...
Thanks!
Try something like this (sorry do not like all those x... variable names)
Sub Add()
Dim c As Range
Dim wb As Workbook, ws As Worksheet, wsList As Worksheet
Set wb = ActiveWorkbook
Set wsList = wb.Worksheets("List")
Application.ScreenUpdating = False
For Each c In wsList.Range("B66:B88").Cells
ThisWorkbook.Sheets("Template").Copy after:=wb.Sheets(wb.Sheets.Count)
Set ws = wb.Sheets(wb.Sheets.Count) '<< get the just-created sheet copy
On Error Resume Next
ws.Name = c.Value
ws.Cells(33, 7) = c.EntireRow.Columns("G").Value
If Err.Number = 1004 Then
Debug.Print "'" & c.Value & "' already used as a sheet name"
End If
On Error GoTo 0
Next c
Application.ScreenUpdating = True
End Sub
I am pretty new to VBA and am having an issue with my code. I have different hotel names from cell B4 to B27. My goal is to create new worksheets and name each one with the hotel names (going down the list). I tried running the sub procedure below but I am getting an error. The error says:
"Run-time error '1004': Application-defined or object-defined error"
It refers to the line below my comment. Any thoughts on why this is occurring and how I can fix this?
Sub sheetnamefromlist()
Dim count, i As Integer
count = WorksheetFunction.CountA(Range("B4", Range("B4").End(xlDown)))
i = 4
Do While i <= count
' next line errors
Sheets.Add(after:=Sheets(Sheets.count)).Name = Sheets("LocalList").Cells(i, 2).Text
i = i + 1
Loop
Sheets("LocalList").Activate
End Sub
Here is something that I quickly wrote
Few things
Do not find last row like that. You may want to see THIS
Do not use .Text to read the value of the cell. You may want to see What is the difference between .text, .value, and .value2?
Check if the sheet exists before trying to create one else you will get an error.
Is this what you are trying?
Option Explicit
Sub sheetnamefromlist()
Dim ws As Worksheet, wsNew As Worksheet
Dim lRow As Long, i As Long
Dim NewSheetName As String
'~~> Set this to the relevant worksheet
'~~> which has the range
Set ws = ThisWorkbook.Sheets("LocalList")
With ws
'~~> Find last row
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
'~~> Loop through the range
For i = 4 To lRow
NewSheetName = .Cells(i, 2).Value2
'~~> Check if there is already a worksheet with that name
If Not SheetExists(NewSheetName) Then
'~~> Create the worksheet and name it
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = NewSheetName
End With
End If
Next i
End With
End Sub
'~~> Function to check if the worksheet exists
Private Function SheetExists(shName As String) As Boolean
Dim shNew As Worksheet
On Error Resume Next
Set shNew = ThisWorkbook.Sheets(shName)
On Error GoTo 0
If Not shNew Is Nothing Then SheetExists = True
End Function
My assumptions
All cells have valid values i.e which can be used for sheet names. If not, then you will have to handle that error as well.
Workbook (not worksheet) is unprotected
Try,
Sub test()
Dim vDB As Variant
Dim rngDB As Range
Dim Ws As Worksheet, newWS As Worksheet
Dim i As Integer
Set Ws = Sheets("LocalList")
With Ws
Set rngDB = .Range("b4", .Range("b4").End(xlDown))
End With
vDB = rngDB 'Bring the contents of the range into a 2D array.
For i = 1 To UBound(vDB, 1)
Set newWS = Sheets.Add(after:=Sheets(Sheets.Count))
newWS.Name = vDB(i, 1)
Next i
End Sub
Create Worksheets from List
The following will create (and count) only worksheets with valid names.
When the worksheet is already added and the name is invalid, it will be deleted (poorly handled, but it works.)
It is assumed that the list is contiguous (no empty cells).
The Code
Option Explicit
Sub SheetNameFromList()
Const wsName As String = "LocalList"
Const FirstCell As String = "B4"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
Dim ListCount As Long
ListCount = WorksheetFunction.CountA(ws.Range(FirstCell, _
ws.Range(FirstCell).End(xlDown)))
Dim fRow As Long: fRow = ws.Range(FirstCell).Row
Dim fCol As Long: fCol = ws.Range(FirstCell).Column
Dim i As Long, wsCount As Long
Do While i < ListCount
If addSheetAfterLast(wb, ws.Cells(fRow + i, fCol).Value) = True Then
wsCount = wsCount + 1
End If
i = i + 1
Loop
ws.Activate
MsgBox "Created " & wsCount & " new worksheet(s).", vbInformation
End Sub
Function addSheetAfterLast(WorkbookObject As Workbook, _
SheetName As String) _
As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = WorkbookObject.Worksheets(SheetName)
If Err.Number = 0 Then Exit Function
Err.Clear
WorkbookObject.Sheets.Add After:=WorkbookObject.Sheets(Sheets.count)
If Err.Number <> 0 Then Exit Function
Err.Clear
WorkbookObject.ActiveSheet.Name = SheetName
If Err.Number <> 0 Then
Application.DisplayAlerts = False
WorkbookObject.Sheets(WorkbookObject.Sheets.count).Delete
Application.DisplayAlerts = False
Exit Function
End If
addSheetAfterLast = True
End Function
I'm trying to search for a string in a range using VBA. I've cobbled together some code but I keep getting a 1004 error at the "If Not" line:
Sub test1()
Dim wb As Workbook
Dim ws As Worksheet
Dim found_range As Range
Dim search_range As Range
Set wb = Workbooks("D1")
Set ws = wb.Sheets("Master data")
Set search_range = ws.Cells(147, 1).EntireRow
If Not Range(search_range).Find("Test") Is Nothing Then
'match found
Set found_range = Range(search_range).Find("Test")
Debug.Print found_range.Column
Else
MsgBox "No match found"
'no match found
End If
End Sub
Any ideas as to why I'm getting the error?
I'm kind of confused with the double .Find
If your Range.Find method already returns a Range object once, there's no need to set it twice.
Also search_range is already a Range object, so need to try to encapsulate it in another Range() object.
In fact it's the reason, you are getting the error, because it
expects a string inside the type-casted Range(<string>)
As #MathieuGuindon correctly pointed out:
It is the cause of the error, but the reason is because the
unqualified Range call is a child object of whatever the ActiveSheet
is, and you can't do Sheet1.Range(Sheet2.Cells(1, 1), Sheet2.Cells(1,> 10)) - error 1004 is thrown in OP's code because ws isn't the
ActiveSheet; qualifying the Range call with ws would have fixed the
error too... but yeah Range(someRange) is definitely redundant.
Sub test1()
Dim wb As Workbook
Dim ws As Worksheet
Dim found_range As Range
Dim search_range As Range
Set wb = Workbooks("D1")
Set ws = wb.Sheets("Master data")
Set search_range = ws.Cells(147, 1).EntireRow
Set found_range = search_range.Find("Test")
If Not found_range Is Nothing Then
Debug.Print found_range.Address
Else
MsgBox "No match found"
End if
End Sub
You could use:
Option Explicit
Sub test1()
Dim wb As Workbook
Dim ws As Worksheet
Dim found_range As Range, search_range As Range
Set wb = Workbooks("D1")
Set ws = wb.Sheets("Master data")
Set search_range = ws.Rows(147).EntireRow
Set found_range = search_range.Find(What:="Test", LookIn:=xlValues, LookAt:=xlWhole)
If Not found_range Is Nothing Then
Debug.Print found_range.Column
Else
MsgBox "No match found"
'no match found
End If
End Sub
Note:
i you want exact match you should use LookAt:=xlWhole
I want to copy the value from current sheet to another workbooks with auto filter by creating new one, once I run the code I got the error:
Object variable or with block variable not set
Here's the code:
Sub copyvaluetoanothersheet()
Dim selectrange As Range
Dim wb As Workbook
Dim Dsheet As Worksheet
Dim Lastrow As Long
Application.ScreenUpdating = False
Set wb = Workbooks.Add
Set Dsheet = wb.Worksheets(1)
Lastrow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
selectrange = Sheet2.Range("A2:BP" & Lastrow)
With Worksheets("Production data")
.AutoFilterMode = False
selectrange.AutoFilter field:="Branch", Criteria1:="Direct Response"
selectrange.SpecialCells(xlCellTypeVisible).EntireRow.Copy
End With
Dsheet.PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End Sub
Many thanks
You must use Set when assigning object variables (you've done it elsewhere).
Set selectrange = Sheet2.Range("A2:BP" & Lastrow)
Note too that your mixture of sheet code names, tab names, and indexes is confusing, and that your code will error if nothing is visible.
Try following
Sub cpVisible()
Dim MyProdName As String
Dim FilteredRange As Range
Dim myArr As Variant
Sheets("Production Data").Range("$A$2:$BP$50000").AutoFilter Field:="Branch", Criteria1:="Direct Response"
Set FilteredRange = Sheets("Production Data").Range("$A$2:$BP$50000").SpecialCells(xlCellTypeVisible)
FilteredRange.Copy Sheets("Dsheet").Range("A1")
End Sub
I have a small userform with one combo box and 2 text boxes and submit button.
While pressing the submit button, i am getting the object variable not set error.
Here is my code:
Private Sub CommandButton1_Click()
Dim ws As Worksheet, tbl As ListObject, row As ListRow
Set ws = Sheets("Create Account Heads")
Set tbl = ws.ListObjects(Me.TextBox2.Value)
Dim intValueToFind As String, rng As Range
Set rng = tbl.ListColumns(1).DataBodyRange
intValueToFind = LCase(Me.TextBox3.Value)
If rng <> 0 Then
For Each rng In rng
If LCase(rng.Value) = intValueToFind Then
MsgBox ("Account Head with this Name Already Exists.")
Exit Sub
End If
Next rng
Else
'Unprotect the Worksheet
ws.Unprotect Password:="google"
End if
End Sub
i am getting the error in "If rng <> 0 Then" line.
Kindly review and advise to overcome this issue.
Thanks
Salman
Replace your line code of:
If rng <> 0 Then
with:
If Not rng Is Nothing Then