i have got a question about referencing a cell in other worksheet.
I have got this code in VBA:
If Application.CountIf(.Rows(Lrow), '8000')= 0 And Application.CountIf(.Rows(Lrow), '9000')) = 0 Then .Rows(Lrow).Delete
Which is capable for me to delete any row WITHOUT words 8000 and 9000.
However, since there would be future update, how can i adjust the code so that the value for excel to execute can be "DYNAMIC" (i.e. not hard-cored)
Say, if i enter a number at cell (17,2) in SHEET 1, what can i make excel to look at the cell address instead of the "absolute value" from SHEET 2 by VBA?
Thanks.
You could add these couple of lines above the code you already have. This is assuming that you want to change either number by entering them into cell B17 or B18.
Dim lowerBound as Long, upperBound as Long
lowerBound = Sheet1.Range("B17").Value
upperBound = Sheet1.Range("B18").Value
Then replace '8000' in with lowerBound and '9000' with upperBound.
You can add a column X to your source sheet, headed "Condx for DELETE" and fill this column with a formula representing the DELETE condition as a Boolean value - like in your case: =NOT(OR(A2=8000,A2=9000)) (asuming values 8000, 9000, etc. appear in column A)
Then you cycle thru the source table and delete all records for which column X is TRUE. Asuming that
your source has been defined within VBA as a range object (MyRange)
the first row is the header row
no empty cells in first column between header and end of list
the condition is found in 3rd column
a purger could look like this
Sub MySub()
Dim MyRange As Range, Idx As Integer, MyCondx As Integer
Set MyRange = ActiveSheet.[A1] ' represent source data as a range
Idx = 2 ' asuming one header row
MyCondx = 3 ' asuming condition is in 3rd column
Do While MyRange(Idx, 1) <> ""
If MyRange(Idx, MyCondx) Then
MyRange(Idx, 3).EntireRow.Delete
Else
Idx = Idx + 1
End If
Loop
End Sub
This way you have full transparency, no hardcoding and you are very flexible to not only change a set of 2 values but specify whatever condition serves the business.
Hope that helps - good luck
Related
Consider the following table:
I have a series of blank cells with missing data. From this missing data I only have the year in the next column. I need to fill any blank cells with a standard day/month of 30/06. The year of each cell however needs to be the year in the next column. The attached file shows how my data is arranged. So at cell B 2091, the date shall be 30/06/2011 while for cell B 2098 the date shall be 30/06/2018 and at cell B 2100 the date shall be 30/06/2008.
Filter on the blank cells in column B. Then, in the topmost cell (which I'll assume to be B1 but will likely be different), enter a formula similar to the following and fill down
=DATE(C1,6,30)
where the row number in C1 is the same as your first row of data.
You can achieve this with a helper column (any blank column in the same worksheet where you need the dates). In that column enter this formula in the first cell (here in row 2) and copy down.
=IF(ISBLANK(B2),DATE(C2,6,30),B2)
Then copy the Values from the helper column to the date column and delete the helper.
Below is a small macro that is doing the same job. It needs no helper column and over-writes your existing blanks. Before you run it make sure to check the values of the 2 constants at the top and the name of the worksheet (especially the latter!) against your requirements.
Sub WriteStandardDate()
'293
Const FirstDataRow As Long = 2 'change to suit
Const DateClm As Long = 2 'change to suit
' year column must be adjacent to DateClm
Dim R As Long
Dim Arr As Variant
Dim Rng As Range
With Worksheets("Sheet1") ' change name as required
Set Rng = .Range(.Cells(FirstDataRow, DateClm), _
.Cells(.Rows.Count, DateClm).End(xlUp)) _
.Resize(, 2)
Arr = Rng.Value
For R = 1 To UBound(Arr)
If IsEmpty(Arr(R, 1)) Then
Arr(R, 1) = DateSerial(Arr(R, 2), 6, 30)
End If
Next R
Rng.Value = Arr
End With
End Sub
Update: I used the formula suggested by Variatus: =IF(ISBLANK(B2),DATE(C2,6,30),B2) and worked fine through a helper column. There was no need to copy / paste the new dates into the Dates column. I just used the helper column as the new Dates column since full dates from the original column were not changed and got inserted in the helper column thanks to the IFBLANK portion of the formula. Thanks.
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
Currently I have a medical spread-sheet with a list of clients that we have serviced. We have 8 different clinical categories which are denoted by different acronyms - HV,SV,CV,WV,CC,OV,TS and GS.
A client can receive multiple therapies i.e. HV,SV,CV - in the background we have a counter mechanism which would increment each of these records by 1.The formula used for this counter is:
=(LEN('Parent Sheet'!F25)-LEN(SUBSTITUTE('Parent Sheet'!F25,'Parent Sheet'!$P$4,"")))/LEN('Parent Sheet'!$P$4)
At the bottom of the sheet we then have a sum which ads up all the treatments that occurred for that week.
Now the tricky part about this is that we have almost a year's worth of data in this sheet but the summing formulas are set as: SUM(COLUMN 6: COLUMN 53) but due to a need to increase the entries beyond this limit, we have to adjust the sum formula. We have 300 SUM Formulas adding up each of the 8 Criteria items and assigning them to the HV,SV,SC,WV etc. counters.
Would we have to adjust this manually one by one or is there a easier way of doing this?
Thank you very much!
To me, I think you should change the sheet layout a little, create a User Defined Function (UDF) and alter the formulas in your Sum rows for efficient row/column adding (to make use of Excel's formula fill). The only issue is that you need to save this as a Macro-Enabled file.
What you need to change in the formulas is to utilize $ to restrict changes in column and rows when the formula fill takes place.
To illustrate in an example, consider:
Assuming the first data starts at row 6, and no more than row 15 (you can use the idea of another data gap on the top). Alter the Sum row titles to begin with the abbreviation then create a UDF like below:
Option Explicit
' The oRngType refers to a cell where the abbreviation is stored
' The oRngCount refers to cells that the abbreviation is to be counted
' Say "HV" is stored in $C16, and the cells to count for HV is D$6:D$15,
' then the sum of HV for that date (D16) is calculated by formula
' `=CountType($C16, D$6:D$15)`
Function CountType(ByRef oRngType As Range, ByRef oRngCount) As Long
Dim oRngVal As Variant, oVal As Variant, oTmp As Variant, sLookFor As String, count As Long
sLookFor = Left(oRngType.Value, 2)
oRngVal = oRngCount.Value ' Load all the values onto memory
count = 0
For Each oVal In oRngVal
If Not IsEmpty(oVal) Then
For Each oTmp In Split(oVal, ",")
If InStr(1, oTmp, sLookFor, vbTextCompare) > 0 Then count = count + 1
Next
End If
Next
CountType = count
End Function
Formulas in the sheet:
Columns to sum are fixed to rows 6 to 15 and Type to lookup is fixed to Column C
D16 | =CountType($C16,D$6:D$15)
D17 | =CountType($C17,D$6:D$15)
...
E16 | =CountType($C16,E$6:E$15)
E17 | =CountType($C17,E$6:E$15)
The way I created the UDF is to lookup and count appearances of a cell value (first argument) within a range of cells (second argument). So you can use it to count a type of treatment for a big range of cells (column G).
Now if you add many columns after F, you just need to use the AutoFill and the appropriate rows and columns will be there.
You can also create another VBA Sub to add rows and columns and formulas for you, but that's a different question.
It's isn't a great idea to have 300 sum formulas.
Name your data range and include that inside the SUM formula. So each time the NAMED data range expands, the sum gets calculated based on that. Here's how to create a dynamic named rnage.
Sorry I just saw your comment. Following is a simple/crude VBA snippet.
Range("B3:F12") is rangeValue; Range("C18") is rngTotal.
Option Explicit
Sub SumAll()
Dim WS As Worksheet
Dim rngSum As Range
Dim rngData As Range
Dim rowCount As Integer
Dim colCount As Integer
Dim i As Integer
Dim varSum As Variant
'assuming that your said mechanism increases the data range by 1 row
Set WS = ThisWorkbook.Sheets("Sheet2")
Set rngData = WS.Range("valueRange")
Set rngSum = WS.Range("rngTotal")
colCount = rngData.Columns.Count
'to take the newly added row (by your internal mechanism) into consideration
rowCount = rngData.Rows.Count + 1
ReDim varSum(0 To colCount)
For i = 0 To UBound(varSum, 1)
varSum(i) = Application.Sum(rngData.Resize(rowCount, 1).Offset(, i))
Next i
'transpose variant array with totals to sheet range
rngSum.Resize(colCount, 1).Value = Application.Transpose(varSum)
'release objects in the memory
Set rngSum = Nothing
Set rngData = Nothing
Set WS = Nothing
Set varSum = Nothing
End Sub
Screen:
You can use named ranges as suggested by bonCodigo or you could use find and replace or you can insert the columns within the data range and Excel will update the formula for you automatically.
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!)
I would like to do a vertical lookup for a list of lookup values and then have multiple values returned into columns for each lookup value. I actually managed to do this after a long Google search, this is the code:
=INDEX(Data!$H$3:$H$70000, SMALL(IF($B3=Data!$J$3:$J$70000, ROW(Data!$J$3:$J$70000)-MIN(ROW(Data!$J$3:$J$70000))+1, ""), COLUMN(A$2)))
Now, my problem is, as you can see in the formula, my lookup range contains 70,000 rows, which means a lot of return values. But most of these return values are double. This means I have to drag above formula over many columns until all lookup values (roughly 200) return #NUM!.
Is there any possible way, I guess VBA is necessary, to return the values after duplicates have been removed? I'm new at VBA and I am not sure how to go about this. Also it takes forever to calculate having so many cells.
[Edited]
You can do what you want with a revised formula, not sure how efficient it will be with 70,000 rows, though.
Use this formula for the first match
=IFERROR(INDEX(Data!$H3:$H70000,MATCH($B3,Data!$J3:$J70000,0)),"")
Now assuming that formula in in F5 use this formula in G5 confirmed with CTRL+SHIFT+ENTER and copied across
=IFERROR(INDEX(Data!$H3:$H70000,MATCH(1,($B3=Data!$J3:$J70000)*ISNA(MATCH(Data!$H3:$H70000,$F5:F5,0)),0)),"")
changed the bolded part depending on location of formula 1
This will give you a list without repeats.....and when you run out of values you get blanks rather than an error
Not sure if you're still after a VBA answer but this should do the job - takes about 25 seconds to run on my machine - it could probably be accelerated by the guys on this forum:
Sub ReturnValues()
Dim rnSearch As Range, rnLookup As Range, rnTemp As Range Dim varArray
As Variant Dim lnIndex As Long Dim strTemp As String
Set rnSearch = Sheet1.Range("A1:A200") 'Set this to your 200 row value range
Set rnLookup = Sheet2.Range("A1:B70000") 'Set this to your lookup range (assume 2
columns)
varArray = rnLookup
For Each rnTemp In rnSearch
For lnIndex = LBound(varArray, 1) To UBound(varArray, 1)
strTemp = rnTemp.Value
If varArray(lnIndex, 1) = strTemp Then
If WorksheetFunction.CountIf(rnTemp.EntireRow, varArray(lnIndex, 2)) = 0 Then 'Check if value exists already
Sheet1.Cells(rnTemp.Row, rnTemp.EntireRow.Columns.Count).End(xlToLeft).Offset(0, 1).Value =
varArray(lnIndex, 2)
End If
End If
Next Next
End Sub