I am building a module to import text into an Excel workbook. After it imports, I want to format the data as a table. The problem I have is that the import will never have the same range.
I'm using the following code, but it throws an error, Run-time error '424': Object required.
Sub ImportRange()
Dim ws As Worksheet
Dim lRow As Long
Dim lCol As Long
Dim rng As Range
Set ws = ThisWorkbook.Worksheets("Import")
lRow = ws.UsedRange.Row - 1 + ws.UsedRange.Rows.Count
lCol = ws.UsedRange.Column - 1 + ws.UsedRange.Columns.Count
Set rng = ws.Cells(lRow, lCol).Address(True, True)
'MsgBox Cells(lRow, lCol).Address(True, True)
End Sub
I've done quite a bit of searching, but I have been unable to find an answer or figure out how I should be doing this.
The end result would look something like this in the code with the start of the range always being set to $A$1:
ws.ListObjects.Add(xlSrcRange, Range("$A$1:$AM$90"), , xlYes).Name = _
"Import"
If your goal is to set a range to the used range on a sheet, it can be done simpler:
Set rng = ws.UsedRange
Obviously, you need to make sure that the usedrange on that sheet properly represents your imported data.
To convert the range to a table:
Dim Import_Table As ListObject
Set Import_Table = ws.ListObjects.Add(SourceType:=xlSrcRange, Source:=rng, XlListObjectHasHeaders:=xlYes)
Import_Table.Name = "Import"
Note: the code is for Excel 2010. For later versions, replace XlListObjectHasHeaders with HasHeaders
Related
Project Outline: The project I'm working on consists of a file with 2 sheets. The first sheet is a Dashboard of Reports with inputs about who worked it, what department it was for, and the timeframe of each report. This information is then transferred to a second sheet via a Button.
Right now the button copies the data from Dashboard to Data, adding the new information, starting in the first blank row (counted up from the bottom) of Column B. It then requests a Date input for that data from the user.
What I want to happen next:
I need to find the Range based on where the last input from Column A is, to where the last input of Column B is.
Example: Say there is Data from A1:A345. Say there is also Data from B1:B764. I need the VBA script to pull the range A346:A764 so I can then tell it to apply the Date from the input box in Column A for that range. (The dates may be historical and/or out of order so the input from the user is important. )
I'm currently using :
sh2.Cells(Rows.Count, 1).End(xlUp) - to Find the range of Column A
sh2.Cells(Rows.Count, 2).End(xlUp) - to Find the range of Column B
I'm having trouble figuring out a way to compare on range to the other in order to return the correct range for the data.
I've attempted using:
DO UNTIL (Excel crashed, it seems to loop continuously and I'm having trouble finding a way to get it to recognize when to stop)
DO UNTIL Attempt
`sh2.Cells(Rows.Count, 1).End(xlUp)(2).Select
Do Until IsEmpty(ActiveCell.Offset(, 1))
sh2.Cells(Rows.Count, 1).End(xlUp)(2).Value = myDate
Loop`
LOOP UNTIL (Excel crashed, same as above)
FOR EACH with IF NOT (I can't quite figure out how to compare the ranges to return a usable value)
FOR EACH Attempt
`Dim AColLR As Long
Dim BColLR As Long
Dim rngA As Range
Dim rngB As Range
Dim rngC As Range
Dim cell As Range
AColLR = sh2.Cells(Rows.Count, 1).End(xlUp).Row
BColLR = sh2.Cells(Rows.Count, 2).End(xlUp).Row
'Set rngB = sh2.Range("B2:B" & BColLR)
Set rngC = sh2.Range(BColLR - AColLR)
For Each cell In rngC
If Not IsEmpty(cell.Value) Then
cell.Offset(, -1).Value = myDate
End If
Next cell`
FUNCTION (I wasn't able to figure out how to call the function in the Sub, also Function might be broken?)
FUNCTION Attempt
`Function SetDifference(rngA As Range, rngB As Range) As Range
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Dashboard")
Set sh2 = Sheets("Data")
AColLR = sh2.Cells(Rows.Count, 1).End(xlUp).Row
BColLR = sh2.Cells(Rows.Count, 2).End(xlUp).Row
rngA = sh2.Range("A2:A" & AColLR)
rngB = sh2.Range("B2:B" & BColLR)
On Error Resume Next
If Intersect(rngA, rngB) Is Nothing Then
'if there is no common area then we will set both areas as result
Set SetDifference = Nothing
'alternatively
'set SetDifference = Nothing
Exit Function
End If
On Error GoTo 0
Dim aCell As Range
For Each aCell In rngA
Dim Result As Range
If Application.Intersect(aCell, rngB) Is
Nothing Then
If Result Is Nothing Then
Set Result = aCell
Else
Set Result = Union(Result, aCell)
End If
End If
Next aCell
Set SetDifference = Result
End Function`
I'm not sure which method is actually the correct one to use for this type of referencing.
Any assistance would be most appreciated!!
Something like this should work:
Dim cA As Range, cB As Range, ws As Worksheet, rng As Range
Set ws = ActiveSheet 'or some specific sheet
With ws
Set cA = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
Set cB = .Cells(.Rows.Count, "B").End(xlUp).Offset(0, -1)
Set rng = .Range(cA, cB)
End With
rng.Value = "dateHere"
i have an excel/vba issue which seems to occur in excel2010 but not excel2016. for me it is a non comprehensible conversion between a1 and r1c1 notation.
i have a range that is dynamic
Dim rng As Range
rng = Application.Range("worksheet!A4:A" & _
Worksheets("worksheet").Range("A" & rows.Count).End(xlUp).Row
also i have a name-variable (called "Norm") i use as a dropdown option in cells and would like to update it according to the dynamic range using
With Application.Names("Norm")
.Name = "Norm"
.RefersTo = rng.Address
.Comment = ""
End With
both run on Workbook_BeforeSave.
when saving while in vba editing mode everything works as expected, the name-variable has the correct range in a1-notation and the content of Norm is according to the range.
but saving in pure excel-mode results in the range in r1c1-notation which can not be processed by the name-variable leaving it empty. unfortunately i can't find any explanation or solution for that. is this an excel2010 issue or what can i do about that?
Range is a member of worksheet.
Names us a member of workbook.
You Set a range object.
RefersTo should point to the range object, not its address.
Revised code:
Dim rng As Range
WITH THISWORKBOOK.WORKSHEETS("worksheet")
SET rng = .Range(.cells(4, "a"), .cells(.rows.count, "a").end(xlup))
end with
With thisworkbook.Names("Norm")
.Name = "Norm" 'totally redundant, it already has a name identified in the line above
.RefersTo = rng 'no address, just rng
.Comment = ""
End With
Name has two properties RefersTo and RefersToR1C1, which means that you should assign appropriate address style. If you want to be sure you get correct notation, you should use ReferenceStyle parameter:
Names("Norm").RefersTo = "=" & Range("A1").Address(ReferenceStyle:=xlA1)
Names("Norm").RefersToR1C1 = "=" & Range("A1").Address(ReferenceStyle:=xlR1C1)
First, you are not setting your rng object correctly:
rng = Application.Range("worksheet!A4:A" & _
Worksheets("worksheet").Range("A" & rows.Count).End(xlUp).Row
should give you an error, you need to Set your rng object, see code below:
Dim Sht As Worksheet
Dim Rng As Range, LastRow As Long
' set the worksheet object
Set Sht = ThisWorkbook.Worksheets("worksheet")
With Sht
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column A
' set the Range object
Set Rng = .Range("A4:A" & LastRow)
End With
' updating the range that "Norm" refres to
With ThisWorkbook.Names("Norm")
.RefersTo = Rng
End With
I'm working with an excel sheet that converts addresses from one format to another, pastes it in a sheet, and is then supposed to paste the correctly formatted addresses into the next available row in a master sheet of addresses that has thousands of records.
There could be hundreds of addresses that need to be pasted to the master sheet, so I'm trying to avoid limiting my rows and ranges by specific references for example a range like ("A2:A6790") would not work because the lists can get long in both the conversion sheet and the master sheet.
In the example below I use just one address but I need the code to be able to copy paste all the rows that have data (but not the header):
I need the highlighted row to copy to here:
I had to black out some of the addresses for privacy reasons, but I highlighted the row count to show how many records there are.
Here's my code:
`
Private Sub Convert()
Dim sap As Worksheet: Set sap = Sheets("SAP")
Dim con As Worksheet: Set con = Sheets("CONVERSION")
Dim abrv As Worksheet: Set abrv = Sheets("ABRV")
Dim slip As Worksheet: Set slip = Sheets("SLIP")
Dim ads As Worksheet: Set ads = Sheets("ADS")
Dim adsrng As Range: Set adsrng = ads.Range("B:B")
Dim conads As Range: Set conads = con.Range("W:W")
Dim saprngQW As Range: Set saprngQW = sap.Range("q:w")
Dim conrngOU As Range: Set conrngOU = con.Range("o:u")
Dim saprngDO As Range: Set saprngBO = sap.Range("B:O")
Dim conrngBN As Range: Set conrngBN = con.Range("B:N")
Dim sapcity2 As Range: Set sapcity2 = sap.Range("o:o")
Dim concity2 As Range: Set concity2 = con.Range("x:x")
Dim sapunion As Range: Set sapunion = Union(saprngQW, saprngBO)
Dim FndList, x&
'Dim nextrow As Long
'nextrow = slip.Cells(Rows.Count, "A").End(xlUp).Row + 1
'Dim pasteslip As Range: Set pasteslip = slip.Range("A" & nextrow)
sap.Select
sapunion.Copy
con.Select
con.Range("a:a").PasteSpecial xlPasteValues
sap.Select
sapcity2.Copy
con.Select
concity2.PasteSpecial xlPasteValues
adsrng.Copy
con.Select
conads.PasteSpecial xlPasteValues
FndList = abrv.Cells(1, 1).CurrentRegion
For x = 1 To UBound(FndList)
con.Cells.Replace What:=FndList(x, 1), Replacement:=FndList(x, 2), LookAt:=xlWhole, MatchCase:=True
Next
con.Select
con.Range("a:x").Copy slip.Range("A:X" & Rows.Count).End(xlUp).Offset(1, 0)
's2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes *this
was a different approach I was going to try if there's no way to
fix things*
'it comes from this code:
'Sub CopyUnique()
'Dim s1 As Worksheet, s2 As Worksheet
'Set s1 = Sheets("Main")
'Set s2 = Sheets("Count")
's1.Range("B:B").Copy s2.Range("a" & nextrow)
's2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
'End Sub
End Sub
`
I commented out some of the code I tried using before (I kept getting paste area is out of range). The error I'm getting now is: Run-time error '1004': Method 'Range' of object'_Worksheet' failed, when it gets to this line con.Range("a:x").Copy slip.Range("A:X" & Rows.Count).End(xlUp).Offset(1, 0)
Any ideas what I can do? I feel like I'm so close but there's something obvious staring me in the face that I can't see.
Figured it out! Adapted some code I used for another project. Wasn't able to get
it to skip copies but it works!
Dim ldestlRow As Long, i As Long
Dim ins As Variant
Dim h As String, won As String
Dim wo As Range
ldestlRow = slip.Cells(Rows.Count, 1).End(xlUp).Row + 1
ins = con.UsedRange
For i = 2 To UBound(ins)
won = ins(i, 7)
Set wo = Range("W2:W" & ldestlRow).Find(what:=won)
If wo Is Nothing Then
ldestlRow = slip.Cells(Rows.Count, 1).End(xlUp).Row + 1
con.Range("A" & i).EntireRow.Copy slip.Range("A" & ldestlRow)
End If
I am trying to execute a simple code to create a Pivot Table using my data.
Sub PTable()
Dim PT As PivotTable
Dim PTCache As PivotCache
Dim rng As Range
Set rng = Range("A1", Range("A1").End(xlToRight).End(xlDown))
rng.Select
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, rng)
Sheets("New").Activate
Set PT = ActiveSheet.PivotTables.Add(PTCache, Range("A1"), "My_PT")
End Sub
Runtime error 13, Type Mismatch is thrown while setting PTCache. This has been happening very frequently whenever I am working with Pivot Tables on my excel using VBA.
This string Set rng = Range("A1", Range("A1").End(xlToRight).End(xlDown)) is setting very huge range "$1:$1048576".
You can watch it in debugger:
Range("A1", Range("A1").End(xlToRight).End(xlDown)).Address
=> "$1:$1048576"
Maybe something wrong with the range, that you want to use in ActiveWorkbook.PivotCaches.Create?
Try also use this Microsoft's advice about second argument PivotCache.Create:
When passing as a range, it is recommended to either use a string to
specify the workbook, worksheet, and cell range, or set up a named
range and pass the name as a string. Passing a Range object may
cause "type mismatch" errors unexpectedly.
Also, you might try
Set rng = Range("A1").CurrentRegion
which is like Ctrl+Shift+* instead of
Set rng = Range("A1", Range("A1").End(xlToRight).End(xlDown))
Performing a single method (i.e., .CurrentRegion) instead of two methods (i.e., xlToRight followed by xlDown) is likely to be less memory intensive and resolve the Type Mismatch glitch.
I had the same issue as you. I had a code working perfectly until the number of rows was over 60.000 lines, then error 13 :Type mismatch appeared when creating the PivotCache...
Solution: Instead of using a Range variable to store the range do it in a string variable. That way (I don't know why) you can avoid having that error. This code should work:
Sub PTable()
Dim PT As PivotTable
Dim PTCache As PivotCache
'Dim rng As Range
Dim LastRow As Long
Dim LastColumn As Long
Dim RangeString As String
Dim SheetName As String
'Set rng = Range("A1", Range("A1").End(xlToRight).End(xlDown))
'rng.Select
LastRow = UsedRange.Rows.Count
LastColumn = UsedRange.Columns.Count
SheetName = ActiveSheet.Name
RangeString = SheetName & "!R1C1:R" & LastRow & "C" & LastColumn
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, RangeString)
Sheets("New").Activate
Set PT = ActiveSheet.PivotTables.Add(PTCache, Range("A1"), "My_PT")
End Sub
I have a sheet that contains a table (produced from jasper report query). This table will be the source of my pivot table. The Pivot is created using an external connection (From Microsoft Query). since the source table needs to be defined before it can be used in Micrososft Query, could anyone show me how to do it programatically?
INFO:
There are 2 documents here, the first is a protected source data and the second is a Pivot document.
The data is dynamic and the table contains a header.
Is there any way to define the table area using excel programatically with dynamic data?
To answer your comments from the two previous answers (whose, in my opinion, fit your need).
Here is a way to define named range with vba:
Dim Rng1 As Range
'Change the range of cells (A1:B15) to be the range of cells you want to define
Set Rng1 = Sheets("Sheet1").Range("A1:B15")
ActiveWorkbook.Names.Add Name:="MyRange", RefersTo:=Rng1
Source
Here is a way to create a table with vba (remember it will only work on Excel 2007 or higher):
Sub CreateTable()
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$1:$D$16"), , xlYes).Name = _
"Table1"
'No go in 2003
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight2"
End Sub
Source
If you use a table (defined) , you can call table object sample
Sub DefineTable()
Dim tbl As ListObject
Set tbl = Sheets("Plan1").ListObjects(1)
tbl.Range.Select
End Sub
Otherwise is create a dynamic range using a name for example
=OFFSET(Plan1!A1;0;0;counta(Plan1!A:A);counta(Plan1!1:1))
Select a name to this range, and in your pivot define a range at =NameOfInterval
[]'s
Public Function CopyDist() As Variant
On Error Resume Next
CopyDist = 0
' RemoveTableStyle
Dim oSh As Worksheet
Set oSh = ActiveSheet
' Set oSh = 'Sheets("Sheet1")
Dim oNewRow As ListRow
Dim myfirstrow As Integer
Dim mylastrow As Integer
Dim myfirstcolumn As Integer
Dim myValue As Variant
myfirstrow = ActiveCell.Row + 1
mylastrow = ActiveCell.Row + 1
myfirstcolumn = ActiveCell.Column
Cells(myfirstrow, myfirstcolumn).Select
Cells(myfirstrow, myfirstcolumn).Clear
oSh.Range("$A$1:$D$16").Select
oSh.ListObjects.Add(xlSrcRange, oSh.Range("$A$1:$D$16"), , xlYes).Name = "Table1"
'No go in 2003
oSh.ListObjects("Table1").TableStyle = "TableStyleLight2"
' CreateTable
If oSh.ListObjects.Count > 0 Then
myValue =oSh.ListObjects.Count
End If
RemoveTableStyle
CopyDist = 1
End Function
Here's how to approach if you do not know the range size: First get the index refs of the last row / column. Then use the indexes to create "Table1"
Dim lngLastColumn as Long
Dim lngLastRow as Long
Set oxlSheet = oxlWB.Worksheets(1) '''or whichever sheet you need
With oXlSheet
lngLastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.ListObjects.Add(xlSrcRange, .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastColumn)), , xlYes).Name = "Table1"
End With