Macro to adjust an entire row in an Excel table at once - vba

I need a way to programatically adjust an entire row in an excel table based on the ActiveCell, irrespective of what table it's in or where the table is. I was using
ActiveSheet.ListObjects(1).ListRows(ActiveCell.Row - 1).Range.Select
Selection.Style = "Good"
but upon shifting the table down five rows, it now applies the action down a further five rows from the ActiveCell.
I've tried finding a way to replace the - 1 with some sort of - .HeaderRowRange.Row but nothing happens when I activate the macro.


You can take advantage of the ActiveCell.ListObject property. This makes it more flexible, e.g., if there's two tables in a worksheet:
Sub FormatActiveTableRow()
Dim lo As Excel.ListObject
Set lo = ActiveCell.ListObject
If Not lo Is Nothing Then
Intersect(ActiveCell.EntireRow, lo.Range).Style = "Good"
End If
End Sub


If I understood the problem correctly, try using the following code and report back:
ActiveSheet.ListObjects(1).ListRows(ActiveCell.Row - ActiveSheet.ListObjects(1).HeaderRowRange.Row).Range.Select

Related

VBA Pivot deselect values to select a single value

Im trying to create a VBA to eventually loop through a given list filtering out one value at a time from a Pivot table. The issue is with deselecting all options and choosing 1 value. How do you perform this?
The solution below (which i got to work is too slow):
What im trying below is to select the 1st value, then loop through the rest to deselect them and finally choosing the value i want. Is there a faster way to do this?
With ActiveSheet.PivotTables("PivotTable2")
.PivotFields("Name").PivotItems(1).Visible = True
For i = 2 To .PivotItems.Count 'Error here
.PivotItems(i).Visible = False
Next
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Name")
.PivotItems(SelectedPerson).Visible = True
End With
End With

Converting all my relevant comments to an answer.
.PivotItems in your code is referring to With ActiveSheet.PivotTables("PivotTable2"). It should refer to a PivotTable field. For example
ActiveSheet.PivotTables("PivotTable2").PivotFields(1).PivotItems.Count
'~~> OR something like
ActiveSheet.PivotTables("PivotTable2").PivotFields("Name").PivotItems.Count
You can read more about it in PivotItems object (Excel)
Even with this solution it is too slow, it would take me hours to wait for the entire data to loop through. Is there a way to "deselect" everything?
For a faster method, you can remove all filter in one go (without looping) and then simply add the relevant filter as shown below
Dim ws As Worksheet
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws.PivotTables("PivotTable2").PivotFields("Name")
.ClearAllFilters
.PivotFilters.Add Type:=xlCaptionEquals, _
Value1:="SOME VALUE"
'~~> OR something like
'~~> Value1:= ws.Range("A1").Value
End With
Tried both referencing a cell and direct text in VBA. Is it possible that the value is somehow formattet wrongly in the pivot data? As in text in my cell im refering to but something else in the Pivot? – Carlsberg789 24 mins ago
Screenshot in action

Embedded "IF" formula breaks occasionally, VBA alternative?

I have a very large embedded IF formula that appears to occasionally break for no reason. Opening and closing the page a few times eventually gets it working again. I am wondering if there is a VBA alternative for it. Here is the IF formula I am running.
=IF(ISNUMBER(SEARCH("76210",E125)),"_012_00762_10",IF(ISNUMBER(SEARCH("76220",E125)),"_012_00762_20",IF(ISNUMBER(SEARCH("76900",E125)),"_012_00769_00",IF(ISNUMBER(SEARCH("76901",E125)),"_012_00769_01",IF(ISNUMBER(SEARCH("85702",E125)),"_012_00857_02",IF(ISNUMBER(SEARCH("85710",E125)),"_012_00857_10",IF(ISNUMBER(SEARCH("100800",E125)),"_012_01008_00",IF(ISNUMBER(SEARCH("100900",E125)),"_012_01009_00",IF(ISNUMBER(SEARCH("123100",E125)),"_012_01231_00",IF(ISNUMBER(SEARCH("124600",E125)),"_012_01246_00",IF(ISNUMBER(SEARCH("124601",E125)),"_012_01246_01",IF(ISNUMBER(SEARCH("124640",E125)),"_012_01246_40",IF(ISNUMBER(SEARCH("124641",E125)),"_012_01246_41",IF(ISNUMBER(SEARCH("142301",E125)),"_012_01423_01",IF(ISNUMBER(SEARCH("158801",E125)),"_012_01588_01",IF(ISNUMBER(SEARCH("158900",E125)),"_012_01589_00",IF(ISNUMBER(SEARCH("159203",E125)),"_012_01592_03",IF(ISNUMBER(SEARCH("159303",E125)),"_012_01593_03",IF(ISNUMBER(SEARCH("159401",E125)),"_012_01594_01",IF(ISNUMBER(SEARCH("159410",E125)),"_012_01594_10",IF(ISNUMBER(SEARCH("159420",E125)),"_012_01594_20",IF(ISNUMBER(SEARCH("159501",E125)),"_012_01595_01",IF(ISNUMBER(SEARCH("169000",E125)),"_012_01690_00",IF(ISNUMBER(SEARCH("186900",E125)),"_012_01869_00",IF(ISNUMBER(SEARCH("213200",E125)),"_012_02132_00",IF(ISNUMBER(SEARCH("213300",E125)),"_012_02133_00",IF(ISNUMBER(SEARCH("215400",E125)),"_012_02154_00",IF(ISNUMBER(SEARCH("220100",E125)),"_012_02201_00",IF(ISNUMBER(SEARCH("223800",E125)),"_012_02238_00",IF(ISNUMBER(SEARCH("225600",E125)),"_012_02256_00",IF(ISNUMBER(SEARCH("230700",E125)),"_012_02307_00",IF(ISNUMBER(SEARCH("230701",E125)),"_012_02307_01",IF(ISNUMBER(SEARCH("231800",E125)),"_012_02318_00",IF(ISNUMBER(SEARCH("235000",E125)),"_012_02350_00",IF(ISNUMBER(SEARCH("235020",E125)),"_012_02350_20",IF(ISNUMBER(SEARCH("242000",E125)),"_012_02420_00",IF(ISNUMBER(SEARCH("246400",E125)),"_012_02464_00",IF(ISNUMBER(SEARCH("292900",E125)),"_012_02929_00",""))))))))))))))))))))))))))))))))))))))
Basically it is built so a serial number is scanned and it populates a cell for the users who use this sheet with its results from the search. I am already running one macro in this sheet as well. Here is that...
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A2:A500, J2:J500"), Target) ' define range of interest
If Not rng Is Nothing Then ' check it's not "nothing"
If WorksheetFunction.CountA(rng) = rng.Count Then 'check for all of its cells being not empty
On Error GoTo safe_exit 'add error control
Application.EnableEvents = False 'don't do anything until you know something has to be done
rng.Offset(, 1).Value = Date 'write Date next to all relevant changed cells
End If
End If
safe_exit:
Application.EnableEvents = True
End Sub
Maybe there is a better way to build this search using a formula that isn't using embedded IF statements, but i couldn't think of another way to do it. Thanks in advance.

This may be what you're looking for:
=IF(ISNA(MATCH(1,IF(ISERR(SEARCH($A$5:$A$42,$E$125)),0,1),0)),"",INDEX($B$5:$B$42,MATCH(1,IF(ISERR(SEARCH($A$5:$A$42,$E$125)),0,1),0)))
entered as an array formula (CTRL-SHIFT-ENTER).
Here $A$5:$A$42 contains 76210, 76220, ... , 292900 (entered as text, not numbers); and $B$5:$B$42 contains _012_00762_10, _012_00762_20, ... , _012_02929_00.
Hope that helps.

Any time you have to go more than 2 deep on an IF you may want to rethink the usage.
What you can do is build a table from your values. Then reference that table as part of your lookup. Assuming your list of value is in range D8:E45 you could use the formula =VLOOKUP(E125,$D$8:$E$45,2).
The beginning of your table would look like what's seen below. The input result cell is referencing your input value and pulling the match of the second column.
To get your table you can take your source formula and replace (Find and Replace - Ctrl+H) some characters with unique delimiting characters. Then use Text To Columns Alt+D+E and delimit and Copy>Paste special>Transpose to quickly have it close to the format you need.

How to assign macro to a table column in Excel?

Currently I'm creating a macro that reads data from a table column, Asset No. The data is obtained through drop-down menu via data validation from another table in another sheet, DieMaster.
It will then perform Index and Match to find the matching data from DieMaster and insert it into Description column.
In addition, Upon obtaining data, the table column will then copy and paste as value to get the data only. That way the formula won't slow down filter searches.
This is what I have come up with.
Sub convert()
Dim osh As Worksheet
Set osh = ActiveSheet
osh.Range("ProjectEntry[Description]").Formula = "=IF(ISNA(INDEX(DieMaster,MATCH(B4,DieMaster[Asset No],FALSE),2)),"""",INDEX(DieMaster,MATCH(B4,DieMaster[Asset No],FALSE),2))"
osh.Range("ProjectEntry[Description]").Copy
osh.Range("ProjectEntry[Description]").PasteSpecial xlPasteValues
End Sub
I have tested the macro and it works perfectly. However the issue I have now is trying to assign the macro to Asset No column. My plan is to have it so that when a value is selected in a cell within the Asset No column via aforementioned drop-down menu, it will automatically show me the data for description.
Since I cannot assign macro to column using the traditional method, is there an alternative?

You can use the Worksheet_Change Event to accomplish this:
Private Sub Worksheet_Change(Target as Range)
If Not Intersect(Target, Me.ListObjects("ProjectEntry").ListColumns("AssetNo").DataBodyRange) Is Nothing Then
With Me.Range("ProjectEntry[Description]")
.Formula = "=IF(ISNA(INDEX(DieMaster,MATCH(B4,DieMaster[Asset No],FALSE),2)),"""",INDEX(DieMaster,MATCH(B4,DieMaster[Asset No],FALSE),2))"
.Value = .Value
End With
End If
End Sub
My syntax may be slightly off (since I am not on my normal computer), but it will get you close enough to tweak on your own.

Excel VBA - Move Columns depending on name without having a load of variables

I'm trying to organise my columns in some VBA code. I need them in a particular order depending on the value in Row A. I know i can do it using the following method but it's very long winded and looks horrible. Is there any more efficient way to do it?
Current Code
Set Name = Cells.Find(What:="Name", LookAt:=xlWhole)
Then activate the cell, find column and then paste to where i want it. So if the columns went like this:
It would change the order to this
I can't just delete the columns that I don't want because they change position. So if i was to delete columns C:C it might delete what i need on occasion.
I need it so that no matter what columns are there, or how many, it will also go in the same order as shown above.
Thanks

Try this.
Dim Rng As Range
Set Rng = ActiveSheet.UsedRange
If Range("A2").Value = "x" Then
Range("A1,C1,D1").EntireColumn.Hidden = True
Rng.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Sheet2").Range("A1")
End If

Excel VBA Delete empty rows in table

I have a table tabelaClientes in Sheet "Clientes" and I want to delete the rows where the field "Nome" is empty.
How do I do that?
This is what I'm trying:
Sub Cliente()
Dim ws As Worksheet
Dim row As Range
Set ws = Sheets("Clientes")
For Each row In ws.[tabelaClientes[Nome]].Rows
If row.Value = "" Then
row.Delete
End If
Next
Exit Sub
But this is deleting only some of the rows where Nome is empty, not all, why?

You can use a very simple call to SpecialCells() to do that instead of using a loop.
Range("tabelaClientes[Nome]").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Edit: To expand on my answer because I was in a hurry. SpecialCells mimic the menu that you will find in Excel after having pressed F5 and selected "Special cells... Blanks". This has the advantage of selecting all blanks at the same time and then delete the rows. Iteration can be very slow if your table is getting large thus this way will save a lot of time.
It does seem that you cannot delete multiple non-contiguous rows in a table. You can do either one of two things:
1- Convert back the table to a range and change the reference to a standard excel reference
2- Loop through the results of SpecialCells().
Option #2 will yield in slower code because of the loop but it will still be better than looping through all cells and check if they are blank but I can understand that you may need to keep it as a table.