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
Related
I'd like to for each object in a table, open the workbook from a file path in column 4 and copy about 52 cells (which will be in the same place in each workbook) into my active spreadsheet.
Table looks like this
Code is rudimentary because I thought if I could solve the first copy, I could replicate it further
Set tbl = Sheet1.ListObjects("OTJ")
For Each cell In tbl.DataBodyRange.Columns(4).Cells
WB = cell.Value
Workbooks.Open Filename:=WB
Set x = Workbooks.Open(WB)
Set y = ActiveWorkbook
v = x.Sheets("Sheet2").cell("D70")
Cells(2, 5) = v
x.Close
I keep getting the subscript out of range error, please help
It's not really clear where you want to put the extracted data, but something along these lines should work:
Dim tbl As ListObject, cell As Range, wb As Workbook
Dim wsData As Worksheet
Set wsData = ThisWorkbook.Worksheets("Data") 'or wherever...
Set tbl = Sheet1.ListObjects("OTJ")
For Each cell In tbl.DataBodyRange.Columns(4).Cells
Set wb = Workbooks.Open(cell.Value)
wsData.Cells(2, 5).Value = wb.Sheets("Sheet2").Range("D70").Value
wb.Close False 'no save
Next cell
I have the following code
Sub Workbook_Open()
Dim x As Workbook
Dim y As Workbook
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.AlertBeforeOverwriting = False
Set x = ThisWorkbook
Set y = Workbooks.Open("N:\\REAL PATH")
'Opens Data and Pastes Values
x.Worksheets("Event Data").Range("Table1[#All]").Copy
y.Worksheets("CoreData").Range("A1").PasteSpecial Paste:=xlPasteValues
x.Worksheets("Comments").Range("Table2[#All]").Copy
y.Worksheets("CommentsData").Range("A1").PasteSpecial Paste:=xlPasteValues
x.Worksheets("Match Data").Range("Table3[#All]").Copy
y.Worksheets("MatchDetails").Range("A1").PasteSpecial Paste:=xlPasteValues
y.Close SaveChanges:=True
ActiveWorkbook.Save
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
After running the code, I go to the workbook named y, and I find that Table 1's data has been pasted three times. So, basically, the y.Worksheets lines are working properly but it won't copy data from Table 2 or 3. If I hit ctrl + g and type in "Table2[#All]" I am taken to the full Table 2, so I know that the range exists and that VBA should be able to find it. Table 1 contains quite a bit of data (131k rows + columns to DZ), but I don't know if that's relevant.
I find that creating and using intermediate variables greatly helps to clear up any problems in transferring data. Plus, you can look at these variables when debugging to verify they are correctly set.
Try something along these lines:
Option Explicit
Sub Example()
Dim srcWB As Workbook
Dim dstWB As Workbook
Set srcWB = ThisWorkbook
Set dstWB = Workbooks.Open("N:\\REAL PATH")
Dim srcData As Range
Dim dstData As Range
Set srcData = srcWB.Sheets("Event Data").Range("Table1[#All]")
Set dstData = dstWB.Sheets("CoreData").Range("A1").Resize(srcData.Rows.Count, _
srcData.Columns.Count)
dstData.Value = srcData.Value
Set srcData = srcWB.Sheets("Comments").Range("Table2[#All]")
Set dstData = dstWB.Sheets("CommentsData").Range("A1").Resize(srcData.Rows.Count, _
srcData.Columns.Count)
dstData.Value = srcData.Value
Set srcData = srcWB.Sheets("Match Data").Range("Table3[#All]")
Set dstData = dstWB.Sheets("MatchDetails").Range("A1").Resize(srcData.Rows.Count, _
srcData.Columns.Count)
dstData.Value = srcData.Value
dstWB.Close SaveChanges:=True
End Sub
You've also confused using ThisWorkbook and later using ActiveWorkbook. It's not clear which on you're saving.
This type of "value only" data copy is very fast, and you may not need to disable events or screen updates. You still may need to disable these if you also have event handlers catching worksheet changes.
I run a monthly report that generates 16 tabs (15 worksheets: "Report1" - "Report15"). I've created a sub to create/format a table, and organize the data on Sheet2("Report1").
Objective:
Because of the Table Style, I would now like to loop the macro through "Report1", "Report4", "Report7", "Report10", "Report13" Only.
(Once I figure this out, I'll create a Macro with another Table Style for the other worksheets.)
Issues:
Through 'Googling' I created the below Loop, but the "Set ws = Worksheets(Report1") ws.active is throwing it off.
-Do I need to remove the set ws = worksheets(Report1")?
-I had the ws.active, because the macro didn't seem to work without it.
Macro:
Option Explicit
Sub LoopThroughSpecificWorksheets()
'Turn Off Screen Updates
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim ws As Worksheet
Dim LstObj As ListObjects
Dim LastRow As Long
Dim Report, i
Report = Array("Report1", "Report4", "Report7", "Report10", "Report13")
For i = LBound(Report) To unbound(Report)
With ws(Report(i))
Set ws = Worksheets("Report1")
ws.Activate
'...Body of Maco
'Insert Table
'Remove Table Format
'Apply Tablestyle:
'Apply a filter to $ Share for all Brands (Largest to Smallest)
'Update $ - % Chg formula
'Update Units - % Chg Formula
'Change Header Names and Resize
End With
Next i
'Turn On Screen Updates
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Below is some VBA code that loops your array of worksheets:
Sub sLoopArray()
Dim ws As Worksheet
Dim aReport As Variant
Dim lngLoop1 As Long
aReport = Array("Report1", "Report2")
For lngLoop1 = LBound(aReport) To UBound(aReport)
Set ws = Worksheets(aReport(lngLoop1))
With ws
End With
Next lngLoop1
End Sub
I've changed the type of unbound to UBound, declared the loop counter as Long (you had it as a variant which can cause problems), and also renamed the array from Report to aReport (to avoid "collision" with any inbuilt VBA names.
Regards,
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 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.