I have 7 columns representing 7 diferent (let's call it) sources of input.
Row 1 of each column has the names of each source.
Row 2 of each column is a sum of all rows from the 4th down. Ex: A2 = SUM(A4:A1048576)
Since I am suposed to make random entries to each column, I want Row 3 of each column to be standard user input field so that any value input on 3rd row of each column is appended to the first empty cell in that column, triggered by some event (keypress, buttonpress, sheetupdate?). That is, the first entry to column "A" in "A3" will be put in "A4", second entry to "A3" should be put in "A5" and so on. Same goes for each column, independently. Also, if possible, I want cells in Row 3 to be cleared in the end.
How do i do this?
Please, answer with full tutorial explanation or a heavily sourced one, because my experience with EXCEL and VBA is close to none.
For anyone else finding this answer, understand that each column is independent of the others so it doesn't matter if the row counts vary by column.
Paste the following code into the Worksheet you plan to use. This will monitor changes ONLY in row 3 (but all columns - you can alter to only monitor the seven columns you want to watch).
When a change is detected in row 3, the column is determined, then the last used ROW is found for that column. The value entered is moved to the first available row, the value entered on row 3 is erased, and the SUM in row 2 is updated to reflect the new sum range.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ColName As String
Dim lLastRow As Long ' Saves Last Row for any column
Dim lColumn As Long
' This will monitor changes made in row 3 only.
' - move entered value to end of column
' - erase row 3 value entered
' - change 'SUM' in row 2 to reflect new row
On Error GoTo Enable_Events ' Need this! If error, need to enable events!!
If Target.Row <> 3 Then Exit Sub ' Only track row 3 changes
Application.EnableEvents = False ' Turn off event tracking because we make changes
lColumn = Target.column ' Get column that's being used.
With ActiveSheet 'Find the last used row in a Column
lLastRow = .Cells(.Rows.Count, Target.column).End(xlUp).Row
End With
Cells(lLastRow + 1, Target.column).value = Target.value ' Move value to end
Target.value = "" ' Clear value entered
' Get Column name (A, B, C...) then create new SUM
ColName = Left(Cells(1, lColumn).Address(False, False), 1 - (lColumn > 26))
Cells(2, lColumn).Formula = "=SUM(" & ColName & "4:" & ColName & lLastRow + 1 & ")"
Enable_Events:
Application.EnableEvents = True
End Sub
Related
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
A little Help again please.
Codes below work for hiding columns that do not match B5.
Now my problem is, I want to unhide column that matches values
from B6 and B7 at the same time.
Reference Values from Command Sheet Column B Row 5,6,7.
Let B5 is MARCH
Let B6 is JANUARYsample picture
Let B7 is FEBRUARY
Sheet Name (GRA_NewGen CI) Note that All Data's per row/column are here.
Range from Sheet Name to Match B5,B6,B7 is Column C Row 4 up to End of Column in row with Values.
Below is the 'Code
'Sub GRA_NewGen_CI()
Dim cell As Range
Application.ScreenUpdating = False
With Sheets("GRA_New Gen CI")
For Each cell In .Range("C4", .Range("XFD4").End(xlToLeft))
cell.EntireColumn.Hidden = cell.Value <> Sheets("Command").Range("B5") And Not IsEmpty(cell)
Next cell
End With
Application.ScreenUpdating = True
'End Sub
If all you want is to hide all rows marked "JANUARY", "FEBRUARY" etc. you will have more flexibility and faster action by using Excel's Filter functionality. Learn here about Filters.
That gave me quite a ride. All those hidden columns are tricky. But now it's your turn. Please follow the instructions.
On your 'Command' sheet, find a blank column and enter "Show All" in one of the cells and this function in the cell below that:
="Show "& B5
I prefer you to have all the 12 months in B5:B16, but if you have only Jan to Mar or prefer to change the content on the fly that is OK as well. Copy the formula down for as long as you have relevant data (month names or column captions) in column B. Give the range I just described a name. I gave it the name "DropdownList". Make sure the named range has a 'Scope' of "Workbook" (meaning, it is visible from all parts of the workbook).
Place a command button on the GRA_New sheet in position A4. Perhaps you already have a button elsewhere. In that case I will ask you to play along and make another one for now. Later you can move this button to any other location, including another sheet, but not in a column to be possibly hidden. This command button will be a Validation drop-down. Enter
"Allow" = List and
"Source" =DropdownList (including the = mark.
You should now have a validation dropdown showing "Show All" in first position, "Show January" in second, and more "Show ..." depending upon the size of the named range DropdownList. Make sure that there is a single space between in "Show January" and "Show all", not more and not less, and every line consisting of 2 words, the second of which is relevant.
Now add the following procedure to the code sheet of the "GR_New ..." sheet.
Private Sub Worksheet_Change(ByVal Target As Range)
'17 Mar 2017
If Target.Address = Range("A4").Address Then
SetDisplay_GRA_NewGen Split(Target.Value)(1)
End If
End Sub
In this procedure, please change the reference to "A4" to the cell where you have the validation dropdown.
The next procedure goes into a normal code module. By default its name would be "Module1", but you can give it any name you like.
Sub SetDisplay_GRA_NewGen(ByVal Cmd As String)
' 17 Mar 2017
Dim Spike As String
Dim CountHidden As Integer
Dim FirstColumn As Long, LastColumn As Long
Dim CapRow As Long, Cap As String
Dim C As Long
CapRow = 4
FirstColumn = 3 ' = column C
With Worksheets("GRA_New_Gen_CI")
LastColumn = .UsedRange.Columns.Count
If StrComp(Cmd, "all", vbTextCompare) Then
With Range("DropdownList")
For C = 2 To .Rows.Count
Cap = Split(.Cells(C).Value)(1)
Spike = Spike & "|" & Cap
Next C
End With
For C = FirstColumn To LastColumn ' count hidden columns
Cap = .Cells(CapRow, C).Value
If .Columns(C).Hidden Then
If .Columns(C).Hidden Or InStr(1, Spike, Cap, vbTextCompare) = 0 Then
' if Cap can't be selected it is counted as not hidden
CountHidden = CountHidden + 1
End If
End If
Next C
Application.ScreenUpdating = False
If CountHidden = 0 Then
' hide all except the specified column
.Range(.Columns(FirstColumn), .Columns(LastColumn)).Hidden = True
End If
For C = FirstColumn To LastColumn
With .Columns(C)
If .Hidden Then
Cap = .Cells(CapRow).Value
If StrComp(Cap, Cmd, vbTextCompare) = 0 Then .Hidden = False
End If
End With
Next C
Else
.Range(.Columns(FirstColumn), .Columns(LastColumn)).Hidden = False
End If
End With
Application.ScreenUpdating = True
End Sub
Look for the two declarations in this procedure:
CapRow = 4
FirstColumn = 3
Row 4 is the row on your data sheet in which the program will look for the months names. Column 3 (= "C") will be the first column in which the program will expect to find a month's name. Columns A:B will never be touched.
Now your system is ready. You will need to know how to operate it.
1. When you select "Show All" from the dropdown all columns starting from FirstColumn will be shown. Call this a reset.
2. When you select any of the items from the dropdown columns with that name in CapRow will be shown.
3. When you select another month it will be added to the one already shown.
4. When all columns are shown already, only the selected one will be displayed.
You can modify the range DropdownList anytime, make it longer or shorter. The important thing is that the names in the dropdown are available in the CapRow. The program compares them as text, meaning "show all" is the same as "SHOW ALL".
Hi I have a spreadsheet with the following columns :
Transaction_ID counter State File_Date Date_of_Service Claim_Status NDC_9 Drug_Name Manufacturer Quantity Original_Patient_Pay_Amount Patient_Out_of_Pocket eVoucher_Amount WAC_per_Unit__most_recent_ RelayHealth_Admin_Fee Total_Voucher_Charge Raw_File_Name
There are duplicate transaction ID's here. Is there VBA that would highlight where there are differences between two rows? So there may be data with the same Transaction ID but I want to highlight where they may have other fields that are different, therefore they aren't truly duplicates and would like to see what information is different.
thanks!
Excel's find duplicates conditional format should suffice for this. The problem is that it only works well off one column.
So there may be data with the same Transaction ID but I want to highlight where they may have other fields that are different, therefore they aren't truly duplicates
So instead of tracking duplicates in the Transaction ID column alone, you can try adding a new column and, in that new column, concatenate all the columns for which the combined values should be unique - and then run Excel's find duplicates conditional format on that column.
For example if the combination of [Transaction_ID], [File_Date] and [NDC_9] should be unique, make a new column that combines [Transaction_ID], [File_Date] and [NDC_9] column values - assuming your data is in an actual table you could have a table formula like so:
=[#Transaction_ID]&[#File_Date]&[#NDC_9]
and would like to see what information is different.
You can then filter the dupes in that column, and then, looking at the other columns you can see how they are different. It's not really possible to be any more specific than that with the way you've worded your question...
Assuming:
It's an unsorted dataset
column 1 contains the repeatable ID
the first row contains headers
...the following code (in the SHeet's module) will turn any cell yellow that has a value that is totally unique for the ID that appears in the leftmost column...
Option Explicit
Public Sub HighlightUniqueValues()
Dim r As Long, c As Long 'row and column counters
Dim LastCol As Long, LastRow As Long 'right-most and bottom-most column and row
Dim ColLetter As String
Dim RepeatValues As Long
'get right-most used column
LastCol = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column
'get bottom-most used row
LastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
'assume first column has the main ID
For r = 2 To LastRow 'skip the top row, which presumably holds the column headers
For c = 2 To LastCol 'skip the left-most column, which should contain the ID
'Get column letter
ColLetter = Split(Cells(1, c).Address(True, False), "$")(0)
' Count the number of repeat values in the current
'column associated with the same value in the
'left-most column
RepeatValues = WorksheetFunction.CountIfs(Range("A:A"), Range("A" & r), Range(ColLetter & ":" & ColLetter), Range(ColLetter & r))
' If there is only one instance, then it's a lone
'value (unique for that ID) and should be highlighted
If RepeatValues = 1 Then
Range(ColLetter & r).Interior.ColorIndex = 6 'yellow background
Else
Range(ColLetter & r).Interior.ColorIndex = 0 'white background
End If
Next c
Next r
End Sub
e.g...
This site already has something similar: Copy and insert rows based off of values in a column
but the code doesn't take me quite where I need to go, and I haven't been able to tweak it to make it work for me.
My user has a worksheet with 4 columns, A-D. Column A contains specific contract numbers, column B is blank, column C has part numbers, and column D has the entire range of contract numbers. My user wants to count the number of times the entire range contract numbers has duplicates so I entered the formula =countif($D$2:$D$100000,A2) in cell E2 and copied down, giving me the number of times the specific contract in column A appears in column D. The numbers range from 1 to 11 in this workbook but the number may be higher in other workbooks this method will be used in.
The next thing I need to do is to enter blank cells below all values in column E that are greater than 1, very much like the example in the previously asked question. I then also need to copy in the same row and insert copied cells exactly to match in the same row in column A. Example: Cell E21 has the number 5 so I need to shift cells in column E only so that there are 4 blanks cells directly below it. In column A, I need to copy cell A21 and insert copied cells in four rows directly below.
Just trying to get the blank cells to insert has been a trial, using the code as given in the previous question.
Dim sh As Worksheet
Dim lo As ListObject
Dim rColumn As Range
Dim i As Long
Dim rws As Long
Set sh = ActiveSheet
Set lo = sh.ListObjects("Count")
Set rColumn = lo.ListColumns("Count").DataBodyRange
vTable = rColumn.Value
For i = rColumn.Rows.Count To 1 Step -1
If rColumn.Cells(i, 1) > 1 Then
rws = rColumn.Cells(i, 1) - 1
With rColumn.Rows(i)
.Offset(1, 0).Resize(rws, 1).Cells.Insert
.EntireRow.Copy .Offset(1, 0).Resize(rws, 1).Cells
.Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True
End With
End If
Next
I would be very grateful for any help as I have been fighting with this monster for a week.
While this is indeed possible to do, it might be a good idea to look into moving the list of all contract numbers from column D to a different sheet. Even though it is quite simple to loop through a range and insert rows based on cell values - it'll also create holes in columns D and E.
Here's code for simply adding the rows and copying the values as you specified.
Sub Main()
'---Variables---
Dim source As Worksheet
Dim startRow As Integer
Dim num As Integer
Dim val As String
Dim i As Long
'---Customize---
Set source = ThisWorkbook.Sheets(1) 'The sheet with the data
startRow = 2 'The first row containing data
'---Logic---
i = startRow 'i acts as a row counter
Do While i <= source.Range("E" & source.Rows.Count).End(xlUp).Row
'looping until we hit the last row with a value in column E
num = source.Range("E" & i).Value 'Get number of appearances
val = source.Range("A" & i).Value 'Get the value
If num > 1 Then 'Number of appearances > 1
Do While num > 1 'Create rows
source.Range("A" & i + 1).EntireRow.Insert 'Insert row
source.Range("A" & i + 1) = val 'Set value
num = num - 1
i = i + 1 'Next row
Loop
End If
i = i + 1 'Next row
Loop
End Sub
Of course you could also remove the holes from column D after inserting the new rows and modify the formula in column E so that it remains copyable and doesn't calculate for the copied rows.
Generally it makes things easier if a single row can be thought of as a single object, as creating or deleting a row only affects that one single object. Here we have one row represent both a specific contract and a contract in the all contracts list - this could end up causing trouble later on (or it could be totally fine!)