I have following code
Set wb = ThisWorkbook`
ComboBox7.RowSource = wb.Worksheets("Sheet5").Range("A2", _
Range("A65536").End(xlUp)).Address
If I don't put wb.Sheets("Sheet5").Select before this line, this code throws error
"Application defined or object-defined error"
I want this code to work without selecting the Sheet5.
If I put ComboBox7.RowSource = wb.Worksheets("Sheet5").Range("A2:A7").Address then it works fine without selecting the sheet5.
Is there any way to use End(xlUp) without selecting the sheet?
Yes it is possible.
Logic: Find the last row and then use that to create a range which you can assign to your combobox.
Is this what you are trying?
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet5")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rng = .Range("A1:A" & lRow)
End With
ComboBox5.RowSource = rng.Address
End Sub
The other thing is to do this in one line
Private Sub CommandButton1_Click()
Set wb = ThisWorkbook
Set ws = wb.sheets("sheets5")
ComboBox7.RowSource = ws.Range("A2", ws.Range("A65536").End(xlUp)).Address
The second range thinks it is working from the active sheet, you need to tell it otherwise.
Using With is better but this is one line if you are writing code quickly just to get something done.
Related
I'm learning VBA and I'm trying to create a workbook wherein in one sheet (sheet2) it would do the calculation then once the calculation is finished the items in sheet2, I would be able to press a commandbutton with the macro of copying the cells in the other sheet (sheet1). I am successful so far in copying over the data however every time the commandbutton is pressed, the error message
'Run-time error'1004': Application-defined or object-defined error'
would pop up. When the debug option is selected it points to line 4 & 5. I searched all over the internet regarding this issue and I haven't stumbled upon any situation like this. I've followed this https://www.youtube.com/watch?v=Z62yORhPr3Q and it's 5th method I'm running with. The code that I have is:
Private Sub CommandButton1_Click()
Dim Part As Range
For Each Part In Range(Range("Q4"), Range("Q4").End(xlDown))
Sheets("VStock").Range(Part.Value).Value = _
Sheets("Calc").Range(Part.Offset(0, 1).Value).Value
Next Part
End Sub
Any help would be appreciated
Thanks!
Suggestion not to loop the entire column and set the Ranges before the main task of "copy/paste".
In your case the ranges are set up incorrectly
Sheets("VStock").Range(Part.Value).Value = _
Sheets("Calc").Range(Part.Offset(0, 1).Value).Value
.Range should Look into the location of cells, example: .Range("Q4:Q144").Value
in your case, Range ends up with .Range(*theValue*).Value
Correct code Example:
Private Sub CommandButton1_Click()
Dim ws1 As Worksheet: Set ws1 = Sheets("Calc")
Dim ws2 As Worksheet: Set ws2 = Sheets("VStock")
Dim SourceRange, dbRange As Range
Dim lRow as Long
lRow = ws1.Range("Q" & ws1.Rows.Count).End(xlUp).Row
If lRow <= 4 Then
MsgBox ("No data to copy")
Exit Sub
End If
Set SourceRange = ws1.Range("Q4:Q" & lRow) ' Calc
Set dbRange = ws2.Range("Q4:Q" & lRow) ' VStock
dbRange.Value = SourceRange.Offset(0, 1).Value
End Sub
The code I'm trying to write should simply check the different price book entries in my companies system. It should take a purchase order from the past and check which would have been the cheapest price book entry for a specific minimum order quantety.
Before doing that the code defines a Range PBRange which then should be sorted to work with 'if' clauses afterwards.
When defining the PBRange the error 1004 occurs.
When I save and reopen the file a message pops up that there was a problem found with some content in the file. After asking me to recover it the code doesn't work anymore.
The strange thing is that the code worked perfectly fine in the beginning.
Public PBRange As Range
Public PO As Worksheet
Public PB As Worksheet
Sub CheapestPrice()
Dim LastRowPO As Long
Dim LastRowPB As Long
Dim i As Long
Dim j As Long
Set PO = Worksheets("Purchase Orders")
Set PB = Worksheets("Price Book")
'!!!Here the error occurs!!!
Set PBRange = PB.Range("A1", Range("A1").End(xlDown).End(xlToRight))
The code after is just an if else combination with two for loops to work through the 2 worksheets. This should work perfeclty fine.
I expect a range to sort afterwards with different criteria.
Referencing correctly is key to prevent errors. Even if they don't show up immediately, those errors will pop up and tackle your code sooner than later.
Correct referencing could be, for example:
Option Explicit
Public PBRange As Range
Public PO As Worksheet
Public PB As Worksheet
Sub CheapestPrice()
Dim LastRowPO As Long, LastRowPB As Long, i As Long, j As Long
Set PO = ThisWorkbook.Sheets("Purchase Orders")
Set PB = ThisWorkbook.Sheets("Price Book")
Set PBRange = PB.Range("A1", PB.Range("A1").End(xlDown).End(xlToRight))
End Sub
In case you do not specify both the workbook and worksheet, like with Range("A1"), VBA will assume the active workbook and worksheet. If these are not what you intend to refer to, you will likely get an error. You could make your life easier by using a With...End With statement to prevent a lot of typing. E.g.:
Sub example()
Dim LRow As Long
With ThisWorkbook.Sheets(1)
LRow = .Cells(.Rows.Count, "D").End(xlUp).Row
MsgBox LRow
.Range("D1:D" & LRow).Value = "NewValue"
End With
End Sub
You could try:
Option Explicit
Public PBRange As Range
Public PO As Worksheet, PB As Worksheet
Sub test()
Dim LastRowA As Long
With ThisWorkbook
Set PO = .Worksheets("Purchase Orders")
Set PB = .Worksheets("Price Book")
End With
With PB
'Find Sheet PB & Column A last row
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
'With out using LastRowA variable
Set PBRange = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
'Using LastRowA variable
Set PBRange = .Range("A1:A" & LastRowA)
End With
End Sub
I have a macro written that clears contents of the active cell row then calls a module to shift the remaining rows up. I am experiencing a long wait time for the macro to finish running. Not sure if this could be written better to execute quicker. The first module is called when a user clicks "Remove Client" on a User Form. Any help would be appreciated. Thank you!
'Called when user clicks Remove Client on User Form
Sub letsgo()
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Sheets("contactunder")
ws.Range("C" & ActiveCell.Row & ":BJ" & ActiveCell.Row).ClearContents
Call shiftmeup
End Sub
Sub shiftmeup()
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Sheets("contactunder") '/// The underhood of my contacts
With ws.Range("D11:BJ392")
For i = .Rows.Count To 1 Step -1
If IsEmpty(.Cells(i, 1)) Then .Rows(i).Delete Shift:=xlUp
Next
End With
End Sub
Why not change this line:
ws.Range("C" & ActiveCell.Row & ":BJ" & ActiveCell.Row).ClearContents
To this:
ws.Range("C" & ActiveCell.Row & "BJ" & ActiveCell.Row).EntireRow.Delete
This way you can avoid your second sub all together (or keep this as an occasional cleaner rather run it every time you simply need to delete 1 row.)
If you really do need both subs, a common first step for efficiency is to disable screen updating before entering your loop with Application.ScreenUpdating = False and then re-activate it when your loop ends by changing False to True.
This is the followup to urdearboy's answer...
The issue was in your second function and the static range used. You were deleting all the rows at the end, past your data (up to ~380 extra delete row calls). To fix it you should do two things
Only loop to the last row of data
Limit calls to the front end; put all the cells you want to delete into one range and delete it once
Sub ShiftMeUp()
Dim wb As Workbook
Dim ws As Worksheet
Dim DeleteRowRange As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("contactunder") '/// The underhood of my contacts
For i = 1 To GetLastRow(1, ws)
If IsEmpty(ws.Cells(i, 1)) Then Set DeleteRowRange = MakeUnion(ws.Rows(i), DeleteRowRange)
Next
If Not DeleteRowRange Is Nothing Then DeleteRowRange.EntireRow.Delete Shift:=xlUp
End Sub
I used 2 on my commonly used functions to keep the code clean...
MakeUnion
Public Function MakeUnion(Arg1 As Range, Arg2 As Range) As Range
If Arg1 Is Nothing Then
Set MakeUnion = Arg2
ElseIf Arg2 Is Nothing Then
Set MakeUnion = Arg1
Else
Set MakeUnion = Union(Arg1, Arg2)
End If
End Function
GetLastRow
Public Function GetLastRow(Optional Col As Integer = 1, Optional Sheet As Excel.Worksheet) As Long
If Sheet Is Nothing Then Set Sheet = Application.ActiveSheet
GetLastRow = Sheet.Cells(Sheet.Rows.Count, Col).End(xlUp).Row
End Function
I'm having trouble with renaming a worksheet in VBA.
I'm writing a Sub that needs to check if there is a worksheet in the workbook that has a specific name, and if there isn't then make a new sheet with this name.
I get the runtime error 1004 application defined or object defined error. I'm hoping anyone can help me. Here is my code:
Dim ws As Worksheet
Dim ArrayElement As Variant
Dim Current_Tabs(1 To 10) As String
NumberNewTab = 1
Tab_Name_Current_Game = Echt_team1 + "vs. " + Echt_team2
For Each ws In Worksheets 'For every worksheet in this workbook
Found = False
For Each ArrayElement In Current_Tabs array
If Tab_Name_Current_Game = ArrayElement Then
Worksheets(ws).Activate
Worksheets.Select
Found = True
End If
Next ArrayElement
If Found = False Then
Worksheets.Add
Sheets(1).Name = Tab_Name_Current_Game **'Here I get the error**
Current_Tabs(NumberNewTab) = Tab_Name_Current_Game
NumberNewTab = NumberNewTab + 1
End If Next ws
If I use Sheets(1).Name = "Test" then I don't run into errors. I don't get why this would be a problem for VBA. Hoping someone can help me. Thank you!
You never defined Tab_Name_Current_Game.
Add Dim Tab_Name_Current_Game as String to your declarations at the top. Then see what happens.
You can make it much easier:
Public Sub renameSheet()
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim Tab_Name_Current_Game As String
Set wb = Excel.ActiveWorkbook
'The line below is copied from your code, but I don't like it.
'You should pass Echt_team1 and Echt_team2 as input parameters to this Sub.
Tab_Name_Current_Game = Echt_team1 + "vs. " + Echt_team2
On Error Resume Next
Set ws = wb.Worksheets(Tab_Name_Current_Game)
On Error GoTo 0
If ws Is Nothing Then
Set ws = wb.Worksheets.Add
ws.Name = Tab_Name_Current_Game
End If
End Sub
To make the code more reliable, you can also add this function to your code: Function to check if sheet name is valid, and change this line:
ws.Name = Tab_Name_Current_Game
to
ws.Name = legalSheetName(Tab_Name_Current_Game)
It will ensure that the name you are trying to assign to a worksheet is not too long and has no illegal characters.
Using the code below, I open a workbook, I then need to remove all duplicate from the rows in the opened workbook (nb).
Dim nb As Workbook, tw As Workbook, ts As Worksheet
a = Application.GetOpenFilename
If a = False Or IsEmpty(a) Then Exit Sub
With Application
.ScreenUpdating = False
End With
Set tw = ThisWorkbook
Set ts = tw.ActiveSheet
Set nb = Workbooks.Open(a)
I have tried various methods of getting this to work, but it appears I lack a fundamental part in order to call this on the workbook. I get an 424 Object Required error.
'Remove duplicates
Dim r As Range
c = nb.ActiveSheet.UsedRange.Rows.Count
LR = c - 1
Set r = nb.ActiveSheet.Range("A8:H" & LR)
r.RemoveDuplicates Columns:=Array(1), Header:=xlNo
The line that is given the error(424 Object required), is
r.RemoveDuplicates Columns:=Array(1), Header:=xlNo
I think it is because r is a range, but not set to the specific workbook,
When I look at the object r, it is sheet to the Sheet in the wrong workbook. I am not understanding why, because I explicitly mark r as being the external workbook here
Set r = nb.ActiveSheet.Range("A8:H" & LR)
Don't use Activesheet -> it hurts my eyes.
Name your sheet, then call them with
LR = nb.sheets('somesheet').Range("A1:H" & LR)
You'll notice less bugs in your program overall.
Try to explicitly activate the workbook and sheet before setting the range.
Edit
Based on your second problem, you should debug:
1) Check the used range
Dim oRange as excel.range
nb.sheets("NAMEYOURSHEET").activate
set oRange = nb.sheets("NAMEYOURSHEET").UsedRange
In the immediate window type: oRange.select + 'Enter key'.
If you get a bug somewhere here, then you know where your problem lies.
The problem was a merged cell, when there are merged cells in the range that has duplicates the VBA code does not know what to do, as far as I can figure out.
Following is a sub for opening an external workbook, and removed dublicates in a range, from worksheet 1
Sub remDup3()
Dim nb As Workbook, tw As Workbook, ts As Worksheet
a = Application.GetOpenFilename
If a = False Or IsEmpty(a) Then Exit Sub
With Application
.ScreenUpdating = False
End With
Set tw = ThisWorkbook
Set ts = tw.ActiveSheet
Set nb = Workbooks.Open(a)
LR = nb.Sheets(1).UsedRange.Rows.Count
With nb.Sheets(1)
Set Rng = Range("A9:H" & LR)
Rng.RemoveDuplicates Columns:=Array(4), Header:=xlNo
End With
End Sub