Copy and sort macro in vba - vba

I am designing a macro that will copy and sort data by a key in vba. I have begun to write the code and it has worked well so far but for some reason I get an Object Required error at the line : Set rng1 = SourceData.Cells.Range("A2:A" & N). I am unsure why this is happening. Any help would be greatly appreciated.
Sub crossUpdate()
Dim rng1 As Range, rng1Row As Range
N = Cells(Rows.Count, "A").End(xlUp).row
Sheet1.Cells.Select
Selection.Copy
Sheets.Add.Name = "SourceData"
ActiveSheet.Paste
Range("A1").Select
Set rng1 = SourceData.Cells.Range("A2:A" & N)
Set rng1Row = rng1.EntireRow
rng1Row.Sort Key1:=Range("A1")
End Sub

You are getting an error because SourceData is not a thing. It looks like that is supposed to be a worksheet or a range or something, but you have not declared it, nor have you set it.
Update: SourceData is a sheet. To refer to a sheet by name you should use Sheets("Sheetname"). Furthermore, there is no need to refer to the cells of the sheet to get a specific range in the sheet, just go right to the range: Sheets("SourceData").Range("A2:A" & N)

Related

VBA - Copy template sheets to multiple sheets of another workbook if criteria met

I've been trying to get the code to work for the past week with no luck. I tried various modifications, which ends up giving different error codes.
The first Error I was getting was with Set rng = Intersect(.UsedRange, .Columns(2))
Object doesn’t support this property or method
So then I changed this to just going through the entire column just to see if it would work : Set rng = Range("B:B"), when I do that then it reads through and I get an error for Set HyperlinkedBook = Workbooks.Open(Filename:=cell.Offset(0, -1).Value) with the error code:
run time error 1004 Sorry we couldn’t find 24 James.xlsx
Is it possible it was moved, renamed or deleted?
I believe that this line of the code is assuming that the hyperlink should open a different workbook with that name, however this is not the case. The hyperlink on the summary sheet links through to other sheets on the same master workbook, only the templates are on a separate book.
So to overcome this I tried changing this line as well and ended up with the code below, which manages to open the template workbook, and copy just the tab name onto the first sheet and then gives an error for the following line TemplateBook.Sheets("Red").Copy ActiveSheet.Paste, saying
subscript out of range
Sub Summary()
Dim MasterBook As Workbook
Set MasterBook = ActiveWorkbook
With MasterBook
Dim rng As Range
Set rng = Range("B:B")
End With
Dim TemplateBook As Workbook
Set TemplateBook = Workbooks.Open(Filename:=" C:\Users\Desktop\Example template.xlsx")
Dim cell As Range
For Each cell In rng
If cell.Value = "Red" Then
cell.Offset(0, -1).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
TemplateBook.Sheets("Red").Copy ActiveSheet.paste
ElseIf cell.Value = "Blue" Then
cell.Offset(0, -1).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
TemplateBook.Sheets("Blue").Copy ActiveSheet.paste
End If
Next cell
End Sub
I tried several more variations but I just can’t get it to copy the correct template, switch back to the master workbook sheet, follow through the link to correct sheet in the same master workbook, and paste the template.
A few comments about the modifications I made to your code:
Instead of using the entire Column B, try to use only cells in Column B that have values inside them.
Try to avoid using ActiveWorkbook, if the code lies in the same workbook then use ThisWorkbook instead.
When you set a Range, fully qualify it by stating the Workbook and Worksheet, as in : Set Rng = Sht.Range("B1:B" & Sht.Cells(Sht.Rows.Count, "B").End(xlUp).Row).
I replaced your 2 Ifs with Select Case, as they the result in both is the same, and it will also allow you more flexibility in the future to add more cases.
When you copy an entire sheet with TemplateBook.Sheets("Red") and paste it to another Workbook, the syntax is TemplateBook.Sheets("Red").Copy after:=Sht.
Code
Option Explicit
Sub Summary()
Dim MasterBook As Workbook
Dim Sht As Worksheet
Dim Rng As Range
Set MasterBook = ThisWorkbook '<-- use ThisWorkbook not ActiveWorkbook
Set Sht = MasterBook.Worksheets("Sheet3") '<-- define the sheet you want to loop thorugh (modify to your sheet's name)
Set Rng = Sht.Range("B1:B" & Sht.Cells(Sht.Rows.Count, "B").End(xlUp).Row) '<-- set range to all cells in column B with values
Dim TemplateBook As Workbook
Set TemplateBook = Workbooks.Open(Filename:="C:\Users\Desktop\Example template.xlsx")
Dim cell As Range
For Each cell In Rng
Select Case cell.Value
Case "Red", "Blue"
cell.Offset(0, -1).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True '<-- not so sure what values you have here
TemplateBook.Sheets(cell.Value).Copy after:=Sht '<-- paste after the sheet defined
Case Else
' do something if you have other cases , not sure it's needed
End Select
Next cell
End Sub
Edit 1: to copy>>paste contents of the sheet, use the loop below:
For Each cell In Rng
Select Case cell.Value
Case "Red", "Blue"
cell.Offset(0, -1).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True '<-- not so sure what values you have here
Application.CutCopyMode = False
TemplateBook.Sheets(cell.Value).UsedRange.Copy
Sht.Range("A1").PasteSpecial '<-- paste into the sheet at Range("A1")
Case Else
' do something if you have other cases , not sure it's needed
End Select
Next cell
Edit 2: Create a new worksheet, and then rename it with the cell.Offset(0, -1).Value
TemplateBook.Sheets(cell.Value).Copy after:=Sht
Dim CopiedSheet As Worksheet
Set CopiedSheet = ActiveSheet
CopiedSheet.Name = cell.Offset(0, -1)

VBA Macro Crashing for When Pasting Range to Table

I'm trying to create a macro in which it takes a dynamic number of rows (user inputted) and pastes them into a table in a different sheet. I was having a difficult time searching and finding ways for doing this at first. I have a workaround below that works the first time (it correctly takes the 'raw' range and pastes it into the table) when I run it from VBA but crashes when I press the macro-assigned button right after. My code is below:
Sub AddRawData()
Dim count_of_data As Long
Dim rng As Range
Set rng = Sheets("New Input Raw Data").Range("B5", Range("B5").End(xlDown).End(xlToRight))
count_of_data = rng.Rows.Count
Sheets("Master Data").Select
For x = 1 To count_of_data
ActiveSheet.ListObjects(1).ListRows.Add
Next x
Sheets("New Input Raw Data").Select
rng.Select
rng.Cut
Sheets("Master Data").Select
Range("b65536").End(xlUp).End(xlUp).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
End Sub
I'm stuck at the moment and have tried various work arounds like using ActiveCell.paste or Range.Paste, but run into the same crashing issue. Any suggestions or code corrections would be greatly appreciated. Thank you!
If you want to copy the new inserted data from New Input Raw Data worksheet to the end of existing data in Master Data sheet, you don't need all the Select and most of the lines, you can just run the code below:
Sub AddRawData()
Dim rng As Range
Dim sht_NewData As Worksheet
Dim sht_MasterData As Worksheet
Set sht_NewData = ThisWorkbook.Worksheets("New Input Raw Data")
Set sht_MasterData = ThisWorkbook.Worksheets("Master Data")
sht_NewData.Select
Set rng = sht_NewData.Range("B5", Range("B5").End(xlDown).End(xlToRight))
rng.Copy Destination:=sht_MasterData.Range("B" & sht_MasterData.Cells(sht_MasterData.Rows.Count, "B").End(xlUp).Row + 1)
End Sub

"Extract range is not defined": advanced filter

I am trying to run this simple code in VBA but it keeps giving me "extract range is not defined" error:
Private Sub CommandButton1_Click()
'Dim rng As Range
Dim RowLast As Long
Dim perporig As Workbook
count = 0
Set perporig = Workbooks.Open("\\Etnfps02\vol1\DATA\Inventory\Daily tracking\perpetual.xlsx", , ReadOnly)
With perporig.Sheets("perpetual")
.AutoFilterMode = False
RowLast = .Cells(Rows.count, "A").End(xlUp).row
'Set rng = .Range("C4:C" & RowLast)
Range("A3:J" & RowLast).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("N1:N6"), Unique:=False 'have also tried Range("A3:J3"), doesn't work.
End With
ThisWorkbook.Sheets("myperpetual").Range("A5", "J5").PasteSpecial xlPasteValues
End Sub
I am trying to copy from a file with data starting from A4:J4 to some A16000:J16000. I have to filter the values in column C to a range I have specified in the worksheet in range N1:N6.
FYI: Table header A4 is empty, and B4:J4 have relevant headers in them.
Also please let me know if my copy-paste method is wrong, or for some reason wouldn't work as expected.
EDIT: I also tried adding a header in column A , i.e. cell A3. Still doesn't work.
My range N1:N6 is a list of numbers, but I am sure the mistake lies there. It doesn't specify which column to apply filter on.
Once you are inside the With perporig.Sheets("perpetual") ... End With block, preface all Range objects and Range.Cells property references with a period (aka . or full stop).
With perporig.Sheets("perpetual")
.AutoFilterMode = False
RowLast = .Cells(Rows.count, "A").End(xlUp).row
'Set rng = .Range("C4:C" & RowLast)
.Range("A3:J" & RowLast).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("N1:N6"), Unique:=False
End With
Note .Range("C4:C"... and .Range("N1:N6") prefaced with a period. This indicates that the parent worksheet of the range(s) are defined by the worksheet named in the With ... End With statement. Without it, Excel is making a guess as to which worksheet the range belongs to; typically this would be the ActiveSheet property.

Selecting all data in other worksheet VBA

I am new to VBA and I am trying to write some code that selects gets the range of all of the cells in a different worksheet than the current one, prints it in a message box (for testing purposes), and returns to the original sheet. I intend to use this range to create a pivot table in the new sheet, and so In the end it needs to be of the form "R1C1:R929C25" To do this, I used code that I found here:
How do you select the entire Excel sheet with Range using Macro in VBA?
This is the code that I have so far:
Sheets("My_Sheet_Name").Cells.Select
MsgBox (Str(Range(Cells.Address)))
Sheets(Sheets.Count).Select
However, this returns an error:
Run-time error '1004':
Select method of Range class failed.
Edit:
I have gotten the code to get the range, yet how do I make it into the form "R1C1:R929C25"?
COMPLETED WORKING CODE:
Dim rng As Range
Set rng = Sheets("My_Sheet").UsedRange
Dim rc_range
rc_range = "R" & Trim(Str(rng.Rows.Count)) & "C" & Trim(Str(rng.Columns.Count))
MsgBox (rc_range)
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"My_Sheet!R1C1:" & rc_range, Version:=xlPivotTableVersion10). _
CreatePivotTable TableDestination:=ActiveSheet.Name + "!R4C4",
TableName:=inputValue + "_PivotTable" _
, DefaultVersion:=xlPivotTableVersion10
You have two options. First, you can use a variable to store the range upon which you hope to act. If it's a one time procedure, variables aren't necessary, but if it's a repetitive task, or involves multiple references, use a variable.
Option two is to refer directly to the other range without a variable. Again, use this if it's only a one time action, such as showing a messagebox.
First example:
Set rng = Sheets("My_Sheet").Cells
msgbox(rng.address)
Second example:
msgbox(Sheets("My_Sheet").Cells.Address)
One thing to note, the Sheet.Cells property returns all of the cells on the applicable sheet. So it would always be $A$1:$XFD$1048576
If you only want cells that are actually storing data, try using the UsedRange property, such as:
Set rng = Sheets("My_Sheet").UsedRange
msgbox(rng.address)
Per the updates and the changes in the comments, I'm including the full set of code to declare a range, and use that range in a Pivot Table to be used in a new sheet. Please note, I didn't perform full error checking, so that should be added to the code. For example, check if the new sheet name already exists, or if the pivot table name already exists, and if so, handle accordingly.
Sub CreatePivotFromDynamicRange()
Dim wsNew As Worksheet
Dim rngData As Range
Dim rngDestination As Range
'Add a new worksheet to store the pivot table
'[NOTE] if sheet named "PivotSheet" already exists it will throw error
Set wsNew = Worksheets.Add()
wsNew.Name = "PivotSheet"
'Define the range with the data needed for the pivot
Set rngData = Sheets("My_Data").UsedRange
'define the pivot destination
Set rngDestination = wsNew.Range("A5")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData, _
Version:=xlPivotTableVersion14).CreatePivotTable tabledestination:=rngDestination, _
tablename:="NewPivot", defaultVersion:=xlPivotTableVersion14
End Sub
You can't select cells from a sheet you are not actively on, but you can reference them. What do you want to do with the cells in "My_Sheet_Name"
If you want the range address from a different sheet and don't know the last row or last column then you can use this code.
Sub SelectLastCellInInSheet()
Dim sh As Worksheet
Dim Rws As Long, Col As Integer, r As Range, fRng As Range
Set sh = Sheets("My_Sheet_Name")
With sh
Set r = .Range("A1")
Rws = .Cells.Find(what:="*", after:=r, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Col = .Cells.Find(what:="*", after:=r, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Set fRng = .Range(.Cells(1, 1), .Cells(Rws, Col))
End With
MsgBox fRng.Address
End Sub

Remove Duplicates in VBA excel

I am trying to remove the duplicates at the end of a macro I wrote in vba. The macro runs but when it comes to the point to remove the duplicates it says that the object doesn't support the property or method when the object is Dimed as a range and set as a range as well. I am really confused on why this happening and I can't seem to spot what is causing this error. I have pasted the code below which causes the error and the point where I set the range object. Any help would be greatly appreciated.
Set WS = ThisWorkbook.ActiveSheet
With WS
Set Rng1 = .Range("B2:B" & .Range("B" & .Rows.Count).End(xlUp).Row)
Set rng2 = .Range("C1:D" & .Range("C" & .Rows.Count).End(xlUp).Row)
End With
If UBound(WrdArray2) < 0 Then
ActiveSheet.rng2.RemoveDuplicates
End
End If
Instead of
ActiveSheet.rng2.RemoveDuplicates
Just try the below:
rng2.RemoveDuplicates
What causing the error is you have already set range for object rng2 and rng2 does not include in Activesheet. That is, rng2 is separate object created by you and is not the property of Activesheet.