I have a vba function in excel 2010 that I built using help from people on here. This function copies the contents of a table/form, sorts them, and sends them to the appropriate tables.
Now after running this function I want the original table to be cleared. I can achieve this with the following code, assuming ACell has been defined as the first cell in the table.
ACell.ListObject.Range.ClearContents works fine, the only problem is it deletes the table as well as the data values.
Is there any way around this? I would rather not have to set the table up every time I enter some data.
How about:
ACell.ListObject.DataBodyRange.Rows.Delete
That will keep your table structure and headings, but clear all the data and rows.
EDIT: I'm going to just modify a section of my answer from your previous post, as it does mostly what you want. This leaves just one row:
With loSource
.Range.AutoFilter
.DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
.DataBodyRange.Rows(1).Specialcells(xlCellTypeConstants).ClearContents
End With
If you want to leave all the rows intact with their formulas and whatnot, just do:
With loSource
.Range.AutoFilter
.DataBodyRange.Specialcells(xlCellTypeConstants).ClearContents
End With
Which is close to what #Readify suggested, except it won't clear formulas.
Try just clearing the data (not the entire table including headers):
ACell.ListObject.DataBodyRange.ClearContents
I reworked Doug Glancy's solution to avoid rows deletion, which can lead to #Ref issue in formulae.
Sub ListReset(lst As ListObject)
'clears a listObject while leaving row 1 empty, with formulae
With lst
If .ShowAutoFilter Then .AutoFilter.ShowAllData
On Error Resume Next
With .DataBodyRange
.Offset(1).Rows.Clear
.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
End With
On Error GoTo 0
.Resize .Range.Rows("1:2")
End With
End Sub
There is a condition that most of these solutions do not address. I revised Patrick Honorez's solution to handle it. I felt I had to share this because I was pulling my hair out when the original function was occasionally clearing more data that I expected.
The situation happens when the table only has one column and the .SpecialCells(xlCellTypeConstants).ClearContents attempts to clear the contents of the top row. In this situation, only one cell is selected (the top row of the table that only has one column) and the SpecialCells command applies to the entire sheet instead of the selected range. What was happening to me was other cells on the sheet that were outside of my table were also getting cleared.
I did some digging and found this advice from Mathieu Guindon:
Range SpecialCells ClearContents clears whole sheet
Range({any single cell}).SpecialCells({whatever}) seems to work off the entire sheet.
Range({more than one cell}).SpecialCells({whatever}) seems to work off the specified cells.
If the list/table only has one column (in row 1), this revision will check to see if the cell has a formula and if not, it will only clear the contents of that one cell.
Public Sub ClearList(lst As ListObject)
'Clears a listObject while leaving 1 empty row + formula
' https://stackoverflow.com/a/53856079/1898524
'
'With special help from this post to handle a single column table.
' Range({any single cell}).SpecialCells({whatever}) seems to work off the entire sheet.
' Range({more than one cell}).SpecialCells({whatever}) seems to work off the specified cells.
' https://stackoverflow.com/questions/40537537/range-specialcells-clearcontents-clears-whole-sheet-instead
On Error Resume Next
With lst
'.Range.Worksheet.Activate ' Enable this if you are debugging
If .ShowAutoFilter Then .AutoFilter.ShowAllData
If .DataBodyRange.Rows.Count = 1 Then Exit Sub ' Table is already clear
.DataBodyRange.Offset(1).Rows.Clear
If .DataBodyRange.Columns.Count > 1 Then ' Check to see if SpecialCells is going to evaluate just one cell.
.DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
ElseIf Not .Range.HasFormula Then
' Only one cell in range and it does not contain a formula.
.DataBodyRange.Rows(1).ClearContents
End If
.Resize .Range.Rows("1:2")
.HeaderRowRange.Offset(1).Select
' Reset used range on the sheet
Dim X
X = .Range.Worksheet.UsedRange.Rows.Count 'see J-Walkenbach tip 73
End With
End Sub
A final step I included is a tip that is attributed to John Walkenbach, sometimes noted as J-Walkenbach tip 73 Automatically Resetting The Last Cell
I use this code to remove my data but leave the formulas in the top row. It also removes all rows except for the top row and scrolls the page up to the top.
Sub CleanTheTable()
Application.ScreenUpdating = False
Sheets("Data").Select
ActiveSheet.ListObjects("TestTable").HeaderRowRange.Select
'Remove the filters if one exists.
If ActiveSheet.FilterMode Then
Selection.AutoFilter
End If
'Clear all lines but the first one in the table leaving formulas for the next go round.
With Worksheets("Data").ListObjects("TestTable")
.Range.AutoFilter
On Error Resume Next
.DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
.DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
ActiveWindow.SmallScroll Down:=-10000
End With
Application.ScreenUpdating = True
End Sub
I usually use something very simple if you just want to clear table contents.
Sub Clear_table()
Range("Table1").ClearContents
End Sub
Obviously if you have a workbook with multiple pages you might want to change the code to accommodate that.
Sub Clear_table()
Worksheets("Sheet1").Range("Table1").ClearContents
End Sub
If you want to delete the entire table except your headers, and your formula, you can try this:
Sub DeteteTableExceptFormula()
Dim tb As ListObject
Set tb = activeworksheet.ListObjects("MyTable")
tb.DataBodyRange.Delete
End Sub
Related
Having a small issue. I have a large piece of code that takes a reference number selected by the user and locates corresponding rows (there can be multiple rows or none to locate) on multiple other sheets by filtering and then copying the data.
This works well except it copies all visible data (columns A-N) when I really want it to copy columns A to K (as L to N on the paste sheet is where I have formulas that set reference numbers and therefore can't be pasted over).
I have tried a couple of changes to the below section of code including offset however it either ignores the offset (probably because I'm using xlCellTypeVisible which I had to do as the data that needs to be copied can be across multiple non sequential rows) or I get an error about selection method not supported.
Any thoughts?
sheet that is being copied - DbExtract
Sheet that data is pasted to - DuplicateRecords
Thanks.
Sub UpdateInputWithExisting()
' Other code that works using set with values and active cell offset with values for other sheets
Sheets("TK_Register").Range("A1").CurrentRegion.AutoFilter field:=12, Criteria1:=RefID
Dim DbExtract, DuplicateRecords As Worksheet
Set DbExtract = ThisWorkbook.Sheets("TK_Register")
Set DuplicateRecords = ThisWorkbook.Sheets("EditEx")
DbExtract.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).copy
DuplicateRecords.Cells(31, 3).PasteSpecial xlPasteValues
On Error Resume Next
Sheets("TK_Register").ShowAllData
On Error GoTo 0
ActiveWorkbook.RefreshAll
Sheets("EditEx").Select
ActiveWindow.SmallScroll Down:=-120
Range("B14:M14").Select
MsgBox ("Record Retrieved. Make your changes and ensure you click 'Save Changes' to update the Master Registers")
End Sub
Need to use .Resize method. Replace this line:
DbExtract.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).copy
With this:
With DbExtract.Range("A1").CurrentRegion
.Resize(, .Columns.Count - 3).SpecialCells(xlCellTypeVisible).Copy
End With
I want to delete blank cells in a range (E1:E130).
This code skips cells.
For Each cell In ranger
If cell.Value = "" Then
cell.Delete
End If
next cell
To make my objective more clear: I have a list of cells with text and empty cells in the range E1:E130 and I want to make a list starting on E1 without any empty cells.
Sorting on alphabet for instance would also be a good solution, however that didn't work out for me either.
I'd go like follows
With Range("E1:E130")
If WorksheetFunction.CountA(.Cells) > 0 Then .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp
End With
You could use the Range.SpecialCells Method to delete all blank cells in a specific range at once:
Range("E1:E130").SpecialCells(xlCellTypeBlanks).Delete
You can try with this code to remove blank cell on define range :
Sub RemoveBlankCells()
Dim rng As Range
'Store blank cells inside a variable
On Error GoTo NoBlanksFound
Set rng = Range("E1:E130").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
'Delete blank cells and shift upward
rng.Rows.Delete Shift:=xlShiftUp
Exit Sub
'ERROR HANLDER
NoBlanksFound:
MsgBox "No Blank cells were found"
End Sub
Necromancing an old question here, but:
OP, I'm not sure your issue (of the 'for each cell in range' not deleting all the wanted cells) stems from the following, but before I knew about Range(...).RemoveDuplicates, i wrote 'for loops' for that very task.
At first i ran the loop from top to bottom and removed the unwanted cells. But when you remove a cell, the whole column shifts up, while your counter stays on the same value, so if there were 2 blank, the second one was shifted up when removing the first, and then the loop jumped over the blank.
So I, then, ran the loop bottom to top (step -1), and that took care of this issue.
This should work:
Columns("E:E").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
This one uses special methods and is more useful if you wanna erase all the data associated with the blank cells.
Range("A:B").SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
I have this piece of code which finds the excel row of an item from a list and deletes the items from a list. What I want... is to delete the Excel row as well.
The code is here
Private Sub imperecheaza_Click()
Dim ws As Worksheet
Dim Rand As Long
Set ws = Worksheets("BD_IR")
Rand = 3
Do While ws.Cells(Rand, 4).Value <> "" And Rand < 65000
If ws.Cells(Rand, 4).Value = gksluri.Value * 1 And ws.Cells(Rand, 5).Value = gksluri.List(gksluri.ListIndex, 1) * 1 Then
ws.Range(Rand, 1).EntireRow.Delete '(here I want to delete the entire row that meets the criteria from the If statement)
gksluri.RemoveItem gksluri.ListIndex
Exit Do
End If
Rand = Rand + 1
Loop
End Sub
Where I added ws.Range(Rand,1).EntireRow.Delete is where I want to delete the entire row but I don't know how to do it. What I want... if it finds the same value in a cell like in some selected item of my list to be able to remove both the entire row in excel and the item from the listbox. It works to remove the item from the listbox but I don't know how to remove the row as well
Chris Nielsen's solution is simple and will work well. A slightly shorter option would be...
ws.Rows(Rand).Delete
...note there is no need to specify a Shift when deleting a row as, by definition, it's not possible to shift left
Incidentally, my preferred method for deleting rows is to use...
ws.Rows(Rand) = ""
...in the initial loop. I then use a Sort function to push these rows to the bottom of the data. The main reason for this is because deleting single rows can be a very slow procedure (if you are deleting >100). It also ensures nothing gets missed as per Robert Ilbrink's comment
You can learn the code for sorting by recording a macro and reducing the code as demonstrated in this expert Excel video. I have a suspicion that the neatest method (Range("A1:Z10").Sort Key1:=Range("A1"), Order1:=xlSortAscending/Descending, Header:=xlYes/No) can only be discovered on pre-2007 versions of Excel...but you can always reduce the 2007/2010 equivalent code
Couple more points...if your list is not already sorted by a column and you wish to retain the order, you can stick the row number 'Rand' in a spare column to the right of each row as you loop through. You would then sort by that comment and eliminate it
If your data rows contain formatting, you may wish to find the end of the new data range and delete the rows that you cleared earlier. That's to keep the file size down. Note that a single large delete at the end of the procedure will not impair your code's performance in the same way that deleting single rows does
Change your line
ws.Range(Rand, 1).EntireRow.Delete
to
ws.Cells(Rand, 1).EntireRow.Delete
Better yet, use union to grab all the rows you want to delete, then delete them all at once. The rows need not be continuous.
dim rng as range
dim rDel as range
for each rng in {the range you're searching}
if {Conditions to be met} = true then
if not rDel is nothing then
set rDel = union(rng,rDel)
else
set rDel = rng
end if
end if
next
rDel.entirerow.delete
That way you don't have to worry about sorting or things being at the bottom.
Something like this will do it:
Rows("12:12").Select
Selection.Delete
So in your code it would look like something like this:
Rows(CStr(rand) & ":" & CStr(rand)).Select
Selection.Delete
I'm a new convert from Experts-Exchange since I noticed they increased the 'Free Premium Services' points threshold.
It seems that Excel 2003 has issues with the End(xlup) command when using it in a worksheet that contains an Excel 'List'.. If I select a cell outside the 'list' boundary, and then try to select the last cell in the worksheet by using VBA, I have to call the .Select function twice to make sure I am getting the correct cell. If the original cell is inside the 'list' boundary then i only need one .Select. My hacked together solution is below, with two selects, as I can never be sure what cell may be selected on save. I include a version check at open to run different code in Excel 2007 (this code fails in 2007, where the .End(xlUp) command works properly).
Is there a more eloquent way to handle this?
Thanks for any help!
.Range("A1").Select
.Cells(.Rows.Count, "A").End(xlUp).Select
.Cells(.Rows.Count, "A").End(xlUp).Select
'two .Selects needed to select correct cell in Excel 2003 list because original selection (A1) was not in list'
.Range("A1").Select
.Cells(.Rows.Count, "T").End(xlUp)(-2, 1).Select
.Cells(.Rows.Count, "T").End(xlUp)(-2, 1).Select
'two .Selects needed to select correct cell in Excel 2003 list because original selection (A1) was not in list'
.Cells(.Rows.Count, "T").End(xlUp)(-3, 1).Select
'only one select needed here because original selection above was within the list'
See how this does:
Sub Example()
Dim rngLstCell As Excel.Range
Set rngLstCell = GetLastCell(Excel.Worksheets("Sheet1"))
MsgBox "The last cell is: " & rngLstCell.Address, vbInformation
End Sub
Public Function GetLastCell(ByVal ws As Excel.Worksheet) As Excel.Range
Dim rngRtnVal As Excel.Range
With ws.UsedRange
Set rngRtnVal = .Find("*", .Cells(1, 1), , , xlByRows, xlPrevious)
If rngRtnVal Is Nothing Then
Set rngRtnVal = .Cells(1, 1)
End If
End With
Set GetLastCell = rngRtnVal
End Function
Using find may seem weird at first but it ends up being the most reliable way due to some vagaries in the way empty cells are handled.
This may not be perfect if your data is non-normalized (jagged).
I found that my use of .End(xlUp).Select prior to acting on the .End(xlUp) cell was causing the problem. If I simply avoid the .End(xlUp).Select prior to operating on the .End(xlUp) cell, the problem is less complex. It can be easily solved by preceding any .End(xlUp) operation with .Range("A1").Select. See the code for explanation. This doesn't really fix the problem with improper .End(xlUp) cell 'selection' - but I'm not interested in 'selecting' the cells, just operating on them. I must mention that I use .Range("A1").Select because A1 is outside of the 'list' that I'm manipulating via VBA.
'commented out - just need to add a ".Range("A1").Select" prior to any .End(xlUp) usage (besides .End(xlUp).Select) to make it work in Excel 03
'.Range("A1").Select
'.Cells(.Rows.Count, "A").End(xlUp)(0, 1).Select
'.Cells(.Rows.Count, "A").End(xlUp)(0, 1).Select
''two .Selects needed to select correct cell in Excel 2003 'Lists'
'Set EntryDate = Cells(.Rows.Count, "A").End(xlUp)(0, 1) 'no need to select cell first, then operate on it, as in the code above
'fixed code below
.Range("A1").Select 'needed for Excel 03 to select correct cell
Set EntryDate = Cells(.Rows.Count, "A").End(xlUp) 'just operate on the cell instead of selecting it first
Are you sure the ranges that you were working with were identical? You shouldn't get different results using the End property in Excel 2007 versus 2003.
Looking at your code:
.Range("A1").Select
.Cells(.Rows.Count, "A").End(xlUp).Select
.Cells(.Rows.Count, "A").End(xlUp).Select
Each of these lines of code have exactly zero impact on one another. No honest explanation can be offered about why the End property is giving you different results based on the code you've provided. From what's written, you should get the same results each time. (That's assuming you're working with identical ranges.) I'd be suspicious of any other code that's being executed. I can offer a couple general tips though: If you use End starting with a blank cell, it will stop at the first non-blank cell. If you start with a non-blank cell, the opposite is true. Looking at the screenshot below:
Range("B13").End(xlUp).Select 'selects B12
Range("B12").End(xlUp).Select 'selects B2
Range("A12").End(xlUp).Select 'selects A6
So whether or not your list is contiguous is an issue. Also, it is not necessary to select a range before you do something to it. Telling Excel to select cell A1 does not impact how it executes .Cells(.Rows.Count, "A").End(xlUp).Select. Assuming that line is within a With block that refers to a worksheet, that line of code is the same thing as navigating to cell A65536 (or A1048576 in Excel 2007) and pressing Ctrl + Up. Assuming that cell is blank, Excel will navigate upwards until it finds the first non-blank cell in column A. If your With block refers to a range object, then that line of code will go to the first column, bottom row of that range and navigate upwards until it comes to the first blank or non-blank cell.
I need Help!
I am not well versed in VBA or Macros but i cannot find any other way to accomplish what i need to do without using it.
I have a sheet which i will be using to track Purchase orders, and what i need to do is; when i have a row in sheet 1 (Purchase Orders) which has been recieved i.e. the date of receipt has been recorded in column H i need for the entire row to be cut and pasted into sheet 2 (Received orders).
The header takes up the first 7 rows the rows, so i need the macro to look at rows 8-54. Once the received items are removed from sheet 1, i need the row to also be deleted or preferably for the list to be sorted by column A moving the now empty row which has been cut from open for a future entry.
Any help would be greatly appreciated.
The "Record Macro" feature should be enough to do the task you describe.. In Excel 2007, go to the Developer tab in the Ribbon, and select "Record Macro", and perform exactly the steps you are describing. It will record the equivalent VBA code, which you can then execute - or tweak/modify.
I tested this out, here's one way to do it:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim receivedDate As Range, nextOpen As Range, isect As Range
Set receivedDate = Sheet1.Range("H8:H54")
Set isect = Application.Intersect(Target, receivedDate)
If Not (isect Is Nothing) And IsDate(Target) = True Then
Set nextOpen = Sheet2.Range("A1").End(xlDown).Offset(1, 0)
Target.EntireRow.Copy Destination:=nextOpen.EntireRow
Target.EntireRow.Delete
End If
Application.EnableEvents = True
End Sub
This would be pasted into the Sheet1 code. Any time a cell is changed on sheet1, the code checks to see if it's in the critical range that you specified. (H8:H54) If it is, it then checks to see if it's a date. If it is, it then copies the entire row, puts it in the next open row on Sheet2, and deletes the original row. The cells below it will get shifted up so there are no gaps.
Since the code functions on a cell changing event, it disables "Application.EnableEvents" in order to avoid a loop of changing a cell to call an event which changes a cell to call an event... etc.