I have written VBA code that copies a filtered table from one spreadsheet to another. This is the code:
Option Explicit
Public Sub LeadingRetailers()
Dim rngRows As Range
Set rngRows = Worksheets("StoreDatabase").Range("B5:N584")
With rngRows
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("LeadingRetailersAUX").Range("B2")
End With
Sheets("Leading Retailers").Activate
End Sub
The filter is applied before the code is ran and then the code selects the visible cells and copies them so as to get only those rows that passed the filter.
In the filtered table to be copied I have, in column L of the range, a certain set of names, some of which are repeated in several rows.
I would like to add to the code so that it only copies one row per name in column L. In other words, I would like the code to copy only the first row for each of the names that appears in Column L of the filtered table.
Pehaps something like this can help you. Code will loop through your rows (5 to 584). First it checks if row is hidden. If not, will check if the value in column "L" is already in the Dictionary. If it is not, it will do two things: copy the row to Destination Sheet, and add the value to the Dictionary.
Option Explicit
Public Sub LeadingRetailers()
Dim d As Object
Dim i As Long
Dim k As Long
Set d = CreateObject("scripting.dictionary")
i = 2 'first row of pasting (in "LeadingRetailersAUX")
For k = 5 To 584
If Not (Worksheets("StoreDatabase").Rows(k).RowHeight = 0) Then 'if not hidden
If Not d.Exists(Worksheets("Hoja1").Cells(k, 12).Value) Then 'if not in Dictionary
d.Add Worksheets("StoreDatabase").Cells(k, 12).Value, i 'Add it
Worksheets("LeadingRetailersAUX").Cells(i, 2).EntireRow.Value = Worksheets("StoreDatabase").Cells(k, 1).EntireRow.Value
i = i + 1
End If
End If
Next
End Sub
You could apply another filter to the table to only show the first occurrence of each set of names and then run your macro as usual. See this answer:
https://superuser.com/a/634284
Related
I am using excel userform to input the data. I want for Columns C2:F2, if the user has not inputted any number in it, excel should convert these blanks into 0. And I want it to repeat for the next row when the data for next row is inputted. I tried some simple coding but it didn't work.
Public Sub BlankCells()
Dim rng As Range
rng = Range("C2:C1000", "D2:D1000", "E2:E1000", "F2:F1000")
For Each cell In rng
If cell = "" Then cell.Value = "0"
Next cell
Find
End Sub
It works if use coding for single row only i.e. "C2:F2", but i want it repeat for the next rows as well when the next row gets the data.
When you create a variable for sheet or range, you need to use the Set keyword like this:
Set rng = Range("C2:F1000")
If you'd like to refer to multiple ranges, you can add all the ranges as one comma separated string
I have written a bunch of VBA macros to get my data formatted how I need it, and the last step is to sort by this new column I have generated in ascending order. However, when I hit sort by the new column, the code now places all the empty cells above my newly generated column as I think it is reading the empty as a 0 and sorts it above any alphanumeric data. This is happening because of the UDF I have for sorting the data. I need to insert the new column with the UDF for each new cell that I insert, but I don't know how to define the range in the new column.
I am close to solving this but would love some help.
Essentially what I have tried for placing the data in a new column works, but the way I have set the range is placing it in a bad spot and it can easily be sorted in the wrong order now. I include all of my code, but the issue is in the last portion of it where I am setting a range to place the new data.
I think what is happening is when I set my range from C3-C2000 and populate it, the remaining empty cells are now included in my sort and give me "lower" numbers when I sort it ascending. Thus all the empty cells are ranked higher up in the column.
Option Explicit
Sub ContractilityData()
Dim varMyItem As Variant
Dim lngMyOffset As Long, _
lngStartRow As Long, _
lngEndRow As Long
Dim strMyCol As String
Dim rngCell As Range
Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'make new column for the data to go
lngStartRow = 3 'Starting row number for the data. Change to suit
strMyCol = "A" 'Column containing the data. Change to suit.
Application.ScreenUpdating = False
For Each rngCell In Range(strMyCol & lngStartRow & ":" & strMyCol & Cells(Rows.Count, strMyCol).End(xlUp).Row)
lngMyOffset = 0
For Each varMyItem In Split(rngCell.Value, "_") 'put delimiter you want in ""
If lngMyOffset = 2 Then 'Picks which chunk you want printed out (each chunk is set by a _ currently)
rngCell.Offset(0, 1).Value = varMyItem
End If
lngMyOffset = lngMyOffset + 1
Next varMyItem
Next rngCell
Application.ScreenUpdating = True
'Here is where my problem arises
Range("C:C").EntireColumn.Insert
Dim sel As Range
Set sel = Range("C3:C2000")
sel.Formula = "=PadNums(B3,3)"
MsgBox "Data Cleaned"
End Sub
What I would like instead is a way to insert a new column, then have my UDF "PadNums" populate each cell up to the last cell of the previous column, essentially re-naming all my data from the previous column. I can then sort by the new column in ascending order and my data is in the correct order.
I think perhaps what I should do is copy column B into my newly inserted column C, then use some sort of last row function to apply the formula in all cells. That would give me the appropriate range always based on my original column?
I solved this! What I did was use range and xlDown to last row on column B, then pasted it to C, then inserted my UDF into C using the xlDown range!
I have an excel sheet where I paste some data and I want to run a function automatically on pasting data at the end of each column to count the number of cells that have some text and then give that row which contains formula a specific color.
For example, I paste the below data:
And now I want to run a function at the end of each column which will display the count of cells containing 'Error'.
The function for the first column would be =countif(A2:A9, "Error"), the function for the second column would be =countif(B2:B9, "Error") and so on.
Appreciate any help in advance.
Format a blank table and create a sum row(Click in table -> Tabletools -> Sum row):
Write in the sum row your formula like: =countif([Second],"Error")
Now you can simply copy in your data and it will calculates the occurence in the last row. On pasting the table in, it will move the sum row automaticly downwards.
Expanding on Doomenik's answer
Part 1 Set your data up as a table and insert a total row. Adjust the following table name as appropriate.
Then insert total row by going into the design tab, which appears when you are inside the table range, and checking the Total Row box
A total row will appear at the bottom of the table with a dropdown icon
Starting with column A you want to select the COUNTIF function to apply to the total row which means selecting More Functions from the drop down and then typing in COUNTIF.
In the box that appears enter the following:
Notice that the entire data area of column A in the table is referenced by [ID]. This will be automatically entered when you select the data area of the table A column range when specifying the range argument to COUNTIF i.e. when selecting as below:
The criteria argument is NA() for error.
You then drag the formula from column A, in the total row, across to column C and autofill will do the rest.
Part 2: Apply conditional formatting to the total row by using
=ISFORMULA(INDIRECT("Table1[#Totals]"))
in Excel 2016 or
=LEFT(FORMULATEXT(INDIRECT("Table1[#Totals]")),8) = "=COUNTIF"
in earlier versions.
Entering the formula:
Now, specifying the range to apply to:
I messed around with specifying the last row with
=INDIRECT("Table1[#Totals]")
Turns out, Excel still converts this to the current last row range e.g.
=$A$11:$C$11
And this updates even if i add rows to the table.
Part 3: Adding new rows by pasting
Now, how to handle the adding of rows by pasting? Insert the following code by Zak into the worksheet containing the table.
Then paste the new rows into the first column of the totals row and it will update and shift the totals down.
Option Explicit
Private Const SingleRowOnly As Boolean = False
Private Const MaxRowCount As Long = 100
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResizeRange As Range
Dim Table As ListObject
Dim TotalsShowing As Boolean
Dim ExpandTables As Boolean
Dim RowIndex As Long
Dim RowCount As Long
' Make sure sheet isn't protected
If Me.ProtectContents Then Exit Sub
' If already in a table, then exit
If Not Target.ListObject Is Nothing Then Exit Sub
' Make sure only one row is being changed
If Target.Rows.Count > 1 Then Exit Sub
' Make sure we're not in row 1
If Target.Row = 1 Then Exit Sub
' Make sure we're in the row right under the Totals row
If Target.Offset(-1, 0).ListObject Is Nothing Then Exit Sub
' Set table
Set Table = Target.Offset(-1, 0).ListObject
TotalsShowing = Table.ShowTotals
ExpandTables = Application.AutoCorrect.AutoExpandListRange
' If Totals not showing, exit
If Not TotalsShowing Then Exit Sub
' Make sure the selection is a contiguous range
If Target.Areas.Count > 1 Then Exit Sub
' Make sure Target range is within the table columns
If Target(1, 1).Column < Table.ListColumns(1).Range.Column Then Exit Sub
If Target(1, Target.Columns.Count).Column > Table.ListColumns(Table.ListColumns.Count).Range.Column Then Exit Sub
' Prepare to adjust table
Application.EnableEvents = False
Table.ShowTotals = False
Application.AutoCorrect.AutoExpandListRange = True
' Set the resize range
If WorksheetFunction.CountA(Table.Range(1, 1).Offset(Table.Range.Rows.Count + 1).Resize(1, Table.Range.Columns.Count)) > 0 Then
If Not SingleRowOnly Then
RowIndex = Target.Row
RowCount = RowIndex
Do Until WorksheetFunction.CountA(Me.Range(Me.Cells(RowCount, Table.Range(1, 1).Column), Me.Cells(RowCount, Table.Range(1, Table.ListColumns.Count).Column))) = 0 Or RowCount - RowIndex > MaxRowCount
RowCount = RowCount + 1
Loop
Set ResizeRange = Table.Range.Resize(Table.Range.Rows.Count + RowCount - RowIndex, Table.Range.Columns.Count)
Else
Set ResizeRange = Table.Range.Resize(Table.Range.Rows.Count + 1, Table.Range.Columns.Count)
End If
Else
Set ResizeRange = Table.Range.Resize(Table.Range.Rows.Count + 1, Table.Range.Columns.Count)
End If
' Make table adjustment
Table.Resize ResizeRange
' Put things back the way we found them
Application.AutoCorrect.AutoExpandListRange = ExpandTables
Table.ShowTotals = TotalsShowing
Application.EnableEvents = True
End Sub
Quoting from the link:
There are two constants declared at the top of this code.
SingleRowOnly. This specifies whether multiple rows should be included
in appending into the Table, or if only a single row should be.
MaxRowCount. As to not go crazy with appending rows to a Table
automatically, this is the maximum number of rows to include at any
one time. If SingleRowOnly is set to True, this constant is moot.
So you can adjust as appropriate.
With Autocomplete feature it should update column references automatically
EDIT
If you want to auto-do this, maybe you can try to paste the following formula at the end of your data:
=COUNTIF((INDIRECT(ADDRESS(ROW()-8;COLUMN()))):(INDIRECT(ADDRESS(ROW()-1;COLUMN()))); "Error")
Explanation
COUNTIF(range; pattern)
The range is specified with two INDIRECT functions. One pointing to the first row, and one pointing to the last one (those 8 and 1 respectively).
So the range looks like:
(INDIRECT(ADDRESS(ROW()-8;COLUMN()))) : (INDIRECT(ADDRESS(ROW()-1;COLUMN())))
NOTE that I assumed that you have 8 rows in total, but you can put any other number there
I'm using macros to quickly search a large table of student data and consolidate it into a single cell for use in seating plans (I'm a teacher). Most of it works but I have a problem with selecting just the data I need.
Steps:
1. Remove data.
2. Run a formula to check if students fit into particular groups and consolidate their information
3. Format
Different subjects and year groups have different layouts for their data and so this step is causing me problems. I've tried using absolute cell references in step 2 but this doesn't work as sometimes the information that should be in column D is in column E etc.
What I want to be able to do is have a macro that checks the first value in the column (ie the title) and if it doesn't match one of a predetermined list delete the whole column along with it's data.
Dim rng As Range
For Each rng In Range("everything")
If rng.Value = "Test" Or rng.Value = "Test1" Then
rng.EntireColumn.Hidden = True
End If
I think I could use something like this if I could change the output from hiding columns to deleting them?
re: What I want to be able to do is have a macro that checks the first value in the column (ie the title) and if it doesn't match one of a predetermined list delete the whole column along with it's data.
To delete all columns NOT WITHIN the list:
Sub del_cols()
Dim c As Long, vCOL_LBLs As Variant
vCOL_LBLs = Array("BCD", "CDE", "DEF")
With Worksheets("Sheet7") '<~~ set this worksheet reference properly!
For c = .Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsError(Application.Match(.Cells(1, c), vCOL_LBLs, 0)) Then
.Columns(c).Delete
End If
Next c
End With
End Sub
To delete all columns WITHIN the list:
Sub del_cols()
Dim v As Long, vCOL_LBLs As Variant
vCOL_LBLs = Array("BCD", "CDE", "DEF")
With Worksheets("Sheet7") '<~~ set this worksheet reference properly!
For v = LBound(vCOL_LBLs) To UBound(vCOL_LBLs)
Do While Not IsError(Application.Match(vCOL_LBLs(v), .Rows(1), 0))
.Cells(1, Application.Match(vCOL_LBLs(v), .Rows(1), 0)).EntireColumn.Delete
Loop
Next v
End With
End Sub
I have some data in a worksheet in a single row (row 44) where the required data is in columns C,F,I,L and so on (i.e. data required every 3rd column starting from C).
This ends at column 'ET'
I need to extract this and paste it into another worksheet row where there are no column spaces.
I've looked around for solutions but its usually columns but this is data i need in one row.
Assuming this needs to be done even when the data in row 44 changes, you could do a macro. In a procedure, the following code could work as a guideline:
Public Sub copyover()
Dim c As Long
For c = 1 To 50
Worksheets("Sheet2").Cells(1, c).Value = _
Worksheets("Sheet1").Cells(44, c * 3).Value
Next
End Sub
Does this have to be a macro? Put this in the first destination cell on the other worksheet:
=INDEX(Sheet1!$C$44:$ET$44,1,3*(COLUMN(A1)-1)+1)
Then copy right