I have this code below that will auto select a range.
Does anyone know how I can add code to create a table to the selected range?
Thanks!
Sub DynamicRange()
'Best used when first column has value on last row and first row has a value in the last column
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("D9")
'Find Last Row and Column
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
End Sub
Use the following Excel VBA code snippet to add the Table object corresponding to selected Range:
Dim objTable As ListObject
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
You can also apply optional styling to the added Table object like shown below:
objTable.TableStyle = "TableStyleMedium2"
More details available at MSDN: https://msdn.microsoft.com/en-us/library/office/ff823155.aspx
Hope this will help.
Related
Hi there I am trying to select a range "A2:H2" down to the last filled cell based on column A (so in this case it should select "A2:H59"). The range is not fixed so it cannot be defined with exact numbers. I have the following code, but it selects everything down to the 402nd row even though there is no data beyond "A59" in the sheet. Any idea what is going on? Thanks for the help!
Global ssaw As Worksheet
Global trckr As Worksheet
Sub DataF()
Dim myRange As Range
Dim myCell As Range
Set ssaw = Sheets("SSAW_DATA")
Set trckr = Sheets("SQL_DATA_FEED")
Set myRange = trckr.Range("A2:H2").end(xlDown)
With myRange
.SpecialCells(xlCellTypeBlanks).Interior.Color = RGB(255, 102, 102)
.SpecialCells(xlCellTypeBlanks).Value = "#missing#"
End With
End Sub
If we assume your last used cell in column A is A59 then …
… This
Set myRange = trckr.Range("A2", trckr.Range("A2").End(xlDown))
will select A2:A59 and this
.Resize(ColumnSize:=8)
will resize it to make it 8 columns width that is A2:H59.
So together we get:
Set myRange = trckr.Range("A2", trckr.Range("A2").End(xlDown)).Resize(ColumnSize:=8)
Use this
trckr.Range("A" & trckr.Rows.Count).End(xlUp)
alternatively to find the last used cell in column A if there can be empty cells in between:
Set myRange = trckr.Range("A2", trckr.Range("A" & trckr.Rows.Count).End(xlUp)).Resize(ColumnSize:=8)
exploit the fact that Range(cell1, cell2) is equivalent to Range(cell2, cell1)
Set myRange = trckr.Range("H2", trckr.Range("A2").End(xlDown))
while if you want to select a range from A2:H2 down to column A last not empty cell (i.e. included empty cells along column A in between the first and last not empty ones):
Set myRange = trckr.Range("H2", trckr.Cells(trckr.Rows.Count, 1).End(xlUp))
I would suggest to use the following code
Option Explicit
Function LastRowInColumn(colName As String)
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, colName).End(xlUp).Row
End With
LastRowInColumn = lastRow
End Function
Sub SelectRg()
Dim rg As Range
Dim wks As Worksheet
Dim lastRow As Long
lastRow = LastRowInColumn("A")
Debug.Print lastRow
If lastRow = 1 Then
' do nothing
Else
Set wks = ActiveSheet
With wks
Set rg = Range(.Cells(2, 1), .Cells(lastRow, "H"))
rg.Select
End With
End If
End Sub
The code determins the last filled row in column A and select based on this information everything to column H
EDIT Improved function
Function LastRowInColumn(ByVal wks As Worksheet, ByVal colName As String) As Long
With wks
LastRowInColumn = .Cells(.Rows.Count, colName).End(xlUp).Row
End With
End Function
EDIT2 And if one would not like to use an extra function you could do it like that
Sub SetRg()
Dim rg As Range
Dim wks As Worksheet
Dim lastRow As Long
Set wks = ActiveSheet
With wks
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'lastRow = LastRowInColumn(wks, "A")
If lastRow > 1 Then
Set rg = Range(.Cells(2, 1), .Cells(lastRow, "H"))
End If
End With
End Sub
I have the following formula in an excel worksheet that I want to make a Macro:
IF(OR(AA2=2,AA2=3,AA2=4),"00",IF(AA2=5,"0"&LEFT(Z2,1),IF(AA2=6,LEFT(Z2,2))))
I want to establish this formula for a certain range based on another column. I have multiple formulas written already that work to do this such as:
Range("B3:B" & Cells(Rows.Count, "M").End(xlUp).Row).Value = "=B2+1"
Basically I want to make the If/Or statement above work in VBA with the desired range.
Any help would be appreciated!
Just setup your function, turn on the Macro Recorder, click on the cell that contains your function, hit F2 and hit Enter. If you want to setup dynamic start and end rows, or columns, you can use the methodologies below.
Sub DynamicRange()
'Best used when only your target data is on the worksheet
'Refresh UsedRange (get rid of "Ghost" cells)
Worksheets("Sheet1").UsedRange
'Select UsedRange
Worksheets("Sheet1").UsedRange.Select
End Sub
OR
Sub DynamicRange()
'Best used when first column has value on last row and first row has a value in the last column
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("D9")
'Find Last Row and Column
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
End Sub
OR
Sub DynamicRange()
'Best used when you want to include all data stored on the spreadsheet
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("D9")
'Refresh UsedRange
Worksheets("Sheet1").UsedRange
'Find Last Row and Column
LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row
LastColumn = StartCell.SpecialCells(xlCellTypeLastCell).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
End Sub
OR
Sub DynamicRange()
'Best used when your data does not have any entirely blank rows or columns
Dim sht As Worksheet
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("D9")
'Select Range
StartCell.CurrentRegion.Select
End Sub
OR
Sub DynamicRange()
'Best used when column length is static
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Sheet1")
Set StartCell = Range("D9")
'Refresh UsedRange
Worksheets("Sheet1").UsedRange
'Find Last Row
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Select Range
sht.Range("D9:M" & LastRow).Select
End Sub
You will have a dynamic range from Excel when the formula is entered via VBA as such:
Range( Cells(2,"AB"), Cells (colMVal, "AB")).Formula = "=IF(OR(AA2=2,AA2=3,AA2=4),""00"",IF(AA2=5,""0""&LEFT(Z2,1),IF(AA2=6,LEFT(Z2,2))))"
Note that the formula is entered into row 2 all the way down to the column M value to dictate the final row (colMVal). Also note the double quotes WITHIN the formula.
If anything is required to be FIXED, rather than dynamic, you would use "$", such that:
Range( Cells(2,"AB"), Cells (colMVal, "AB")).Formula = "=IF(OR(AA$2=2,AA$2=3,AA$2=4),""00"",IF(AA$2=5,""0""&LEFT(Z$2,1),IF(AA$2=6,LEFT(Z$2,2))))"
Where I have locked that ALL references verify that the row is 2, hence AA$2. As Excel fills the formula into each row of the desired range, it will dynamically assign the correct row.
I'm trying to use a value from a Combo Box with a list of names as criteria of an AutoFilter and then copy the results from my database (BASE_ACOMPANHAMENTOS) to my results sheet (BUSCA). My Combo Box name is busca_lista and this is what I've tried so far:
Private Sub OKBUSCA_Click()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim lstrw As Long
Set ws = Sheets("BASE_ACOMPANHAMENTOS")
Set ws1 = Sheets("BUSCA")
lstrw = ws.Cells(Rows.Count, 2).End(xlUp).Row
ws1.Range("C12:H100").Clear
ws1.Range("X5").Value = busca_lista.Value
ws.Range("A1:F" & lstrw).AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=ws1.Range("X5"), CopyToRange:=ws1.Range("C11:H11"), Unique:=False
End Sub
As you guys can see, I'm copying the value from my Combo Box to one cell and then using this value as a criteria, but it isn't working because it's showing all the names in my database, not the name that I've searched for. You can see the example below:
The form:
My database:
The results:
Your CriteriaRange needs to include both column heading and values. Based on your code, I've added the heading "Nome" in X4. Your criteria range is X4:X5.
Private Sub OKBUSCA_Click()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim lstrw As Long
Set ws = Sheets("BASE_ACOMPANHAMENTOS")
Set ws1 = Sheets("BUSCA")
lstrw = ws.Cells(Rows.Count, 2).End(xlUp).Row
ws1.Range("C12:H100").Clear
ws1.Range("X4").Value = "Nome"
ws1.Range("X5").Value = busca_lista.Value
ws.Range("A1:F" & lstrw).AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=ws1.Range("X4:X5"), CopyToRange:=ws1.Range("C11:H11"), Unique:=False
End Sub
You have given the value to filter on but not the column. You need to have a cell which also holds the value Nome in in X4 and have your criteriarange as X4:X5
I wrote a code to copy Column D, H, M and paste it on a brand new sheet starting from A-C. I first find the last row , after that I Union the 3 column range together then select the sheet and paste it.
For some reason I don't understand why it does not work. I have never used Union range before so not sure if that is the problem, or if it is something like my for loop. Help would be appreciated.
Dim ws As Worksheet
Dim lastRow As Integer
'for loop variables
Dim transCounter As Integer
Dim range1 As Range
Dim range2 As Range
Dim range3 As Range
Dim multipleRange As Range
Dim lastRow1 As Integer
Dim ittercell As Integer
Set ws = ActiveSheet
For transCounter = 1 To 10
r.AutoFilter Field:=6, Criteria1:=transCounter.Value, Operator:=xlFilterValues
With Application.ActiveSheet
lastRow1 = .Cells(.Rows.Count, "AE").End(xlUp).Row
End With
Set range1 = Sheets("Sheet1").Range("D6:D" & lastRow1).SpecialCells(xlCellTypeVisible)
Set range2 = Sheets("Sheet1").Range("H6:I" & lastRow1).SpecialCells(xlCellTypeVisible)
Set range3 = Sheets("Sheet1").Range("M6:M" & lastRow1).SpecialCells(xlCellTypeVisible)
Set multipleRange = Union(range1, range2, range3)
multipleRange.Copy
Sheets("O1 Filteration").Select
'Range("A3").Select
'Range("A3").PasteSpecial xlPasteValues
ittercell = 1
Cells(3, ittercell).PasteSpecial xlPasteValues
ittercell = ittercell + 6
Next transCounter
There's a couple of issues with your code that might be causing the fault:
r is not defined in your code
use of transCounter.Value instead of just CStr(transCounter) (see #QHarr comment)
iterCell reset every iteration of the loop (see #QHarr comment)
Combination of ActiveSheet, unqualified Cells(... and manual Select on sheets makes the Range qualifications ambiguous
However, I do think the main logic of using Union, then Copy, then PasteSpecial is OK and just some tweaking is required.
Here is some working code where you update the Worksheet and Range references with your own. Please follow the comments.
Option Explicit
Sub CopyUnionColumns()
Dim wsSource As Worksheet '<-- Sheet1 in your code
Dim wsTarget As Worksheet '<-- O1 Filteration in your code
Dim rngFilter As Range '<-- main data range on Sheet1
Dim rngSource As Range '<-- to hold Union'd data after filtering
Dim rngTarget As Range '<-- range in O1 Filteration to paste code to
Dim lngLastRow As Long '<-- last row of main data
Dim lngCounter As Long '<-- loop variable
Dim lngPasteOffsetCol As Long '<-- offset column for pasting in the loop
' set references to source and target worksheets
Set wsSource = ThisWorkbook.Worksheets("Sheet2") '<-- update for your workbook
Set wsTarget = ThisWorkbook.Worksheets("Sheet3") '<-- update for your workbook
' set reference to data for filtering in source worksheet
lngLastRow = wsSource.Cells(wsSource.Rows.Count, 6).End(xlUp).Row
Set rngFilter = wsSource.Range("A1:F" & lngLastRow)
' initialise offset column
lngPasteOffsetCol = 0
' iterate rows
For lngCounter = 1 To 10
' filter data the data per the counter
rngFilter.AutoFilter Field:=6, Criteria1:=CStr(lngCounter), Operator:=xlFilterValues
' set source range as union of columnar data per last row
Set rngSource = Application.Union( _
wsSource.Range("A1:A" & lngLastRow).SpecialCells(xlCellTypeVisible), _
wsSource.Range("C1:C" & lngLastRow).SpecialCells(xlCellTypeVisible), _
wsSource.Range("E1:E" & lngLastRow).SpecialCells(xlCellTypeVisible))
' set target range on target sheet top left cell and offset column
Set rngTarget = wsTarget.Range("A1").Offset(0, lngPasteOffsetCol)
' copy source cells
rngSource.Copy
' paste to target
rngTarget.PasteSpecial Paste:=xlPasteAll
' increment offset
lngPasteOffsetCol = lngPasteOffsetCol + 6
Next lngCounter
' cancel cut copy mode
Application.CutCopyMode = False
' cancel autofilter
wsSource.AutoFilterMode = False
End Sub
My current challenge is that I have a list of data that has been pulled in from another workbook in Columns A-K which all finish on the same row. I want to label the data with all the same value in Column L
The code I have is trying to find the last cell in Column A and the last cell in Column L.
I am then trying to use the range between these two rows to insert a value across the range in Column L:
Sub FillTestType(TestType As String)
Dim rng As Range
Dim wsh As Worksheet
Dim Row As Long
Dim EndCell As Long
Dim TopCell As Long
Set wsh = Worksheets("Sheet1")
wsh.Activate
EndCell = Cells(Rows.count, "A").End(x1Up).Row
TopCell = Cells(Rows.count, "L").End(x1Up).Row
rng = Range(Cells(TopCell, 12), Cells(EndCell, 12)).Value
rng = TestType
End Sub
I keep getting a runtime error - Any help would be greatly appreciated! Or if I am being stupid and there is a better way to tackle the problem please do let me know.
Something like this should work. Mainly collating the comments:
xlUp rather than x1Up (and Option Explicit to catch that yourself in future!)
+1 to TopCell so that you don't overwrite your last value in that row
Fully qualified your Range and Cell references using With and .
Cleaned up variables which aren't necessary -- e.g. for multiple future use or readability
Option Explicit
Sub FillTestType(TestType As String)
Dim EndCell As Long
Dim TopCell As Long
With Worksheets("Sheet1")
EndCell = .Cells(.Rows.Count, "A").End(xlUp).Row
TopCell = .Cells(.Rows.Count, "L").End(xlUp).Row + 1
.Range(.Cells(TopCell, 12), .Cells(EndCell, 12)).Value = TestType
End With
End Sub