I would like to ask whether it is possible to check inconsistent formula for a specific region.
In my case, col D and col E contain different sets of formula.
I just want to ensure that all formula in col E are consistent.
Is it possible to do so??
Here is one way.
Let's say your worksheet looks like this
Now Paste this code in a module and run it. It will tell you which cells have inconsistent formulas. See below screenshot
I have commented the code so that you will not have any problem understanding it. If you do simply ask :)
Option Explicit
Sub GetInConsCells()
Dim ws As Worksheet
Dim rng As Range, cl As Range, errCells As Range
Dim ErrorCells As String
Dim lRow As Long
'~~> Create a temp copy of the sheet
ThisWorkbook.Sheets("Sheet1").Copy After:=Sheets(ThisWorkbook.Sheets.Count)
Set ws = ActiveSheet
With ws
'~~> Clear Col D and Col F Contents
.Range("D:D,F:F").ClearContents
'~~> Find the last row of col E
lRow = .Range("E" & .Rows.Count).End(xlUp).Row
'~~> Set your range
Set rng = Range("E1:E" & lRow)
'~~> Check if the cells have inconsistent formulas
For Each cl In rng
If cl.Errors(xlInconsistentFormula).Value Then
If errCells Is Nothing Then
Set errCells = cl
Else
Set errCells = Union(cl, errCells)
End If
End If
Next cl
'~~> Display relevant message
If Not errCells Is Nothing Then
ErrorCells = errCells.Address
MsgBox "Formulas in cells " & ErrorCells & " are inconsitent"
Else
MsgBox "All Formulas are consistent"
End If
End With
'~~> Delete temp sheet
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Sub
A quick and pragmatic way would be to use another column (temporarily):
Assuming you want to check that each cell in column E has the formula =SUM(A1:D1), simply enter the formula =(SUM(A1:D1)-E1 in another column. Then select the column and filter for FALSE- this will give you all the formulas that have different results!
Related
After numerous failed attempts I am really hoping someone can with my problem. It theory what I am trying to do sounds easy enough but I have spent hours on it today with no success.
I have tried all the possible solutions from this thread but to no avail: Excel vba Autofill only empty cells
Also looked here : https://www.mrexcel.com/board/threads/macro-to-copy-cell-value-down-until-next-non-blank-cell.660608/
I am looking to autofill a formula down a column(a vlookup from another sheet) but if there is already populated cells then to skip and continue the formula in the next available blank cell. For example, in rows A2:A10, row A5 has a value in it, so the formula gets into in A2, then fills to A4, then skips A5, then continues in A6 to A10.
This below code works the first time you use it but then on the second run it debugs with a "Run-time error '1004' - No cells were found". I noticed it it putting the formula into the first cell (B2) and then debugging out.
Sub FillDownFormulaOnlyBlankCells()
Dim wb As Workbook
Dim ws1, ws2 As Worksheet
Dim rDest As Range
Set wb = ThisWorkbook
Set ws1 = Sheets("Copy From")
Set ws2 = Sheets("Copy To")
ws2.Range("A1").Formula = "=IFERROR(IF(VLOOKUP(A2,'Copy From'!A:B,2,FALSE)=0,"""",VLOOKUP(A2,'Copy From'!A:B,2,FALSE)),"""")"
Set rDest = Intersect(ActiveSheet.UsedRange, Range("B2:B300").Cells.SpecialCells(xlCellTypeBlanks))
ws2.Range("B2").Copy rDest
End Sub
Please, try the next code:
Sub FillDownFormulaOnlyBlankCells()
Dim wb As Workbook, ws1 As Worksheet, rngBlanc As Range
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("Copy From")
On Error Resume Next
Set rngBlanc = ws1.Range("B2:B" & ws1.rows.count.End(xlUp).row).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rngBlanc Is Nothing Then
rngBlanc.Formula = "=IFERROR(IF(VLOOKUP(A2,'Copy From'!A:B,2,FALSE)=0,"""",VLOOKUP(A2,'Copy From'!A:B,2,FALSE)),"""")"
Else
MsgBox "No blanc rows exist in B:B column..."
End If
End Sub
After running it once and do not create any empty cell, of course there will not be any blanc cells, anymore, at a second run...
Thanks to FaneDuru for his suggestion but I actually came up with an alternative solution to my problem which I though I would post as it might help others with a similar issue.
On a separate sheet, I created 3 columns, first column is names I already have, 2nd column are the new names and the 3rd column is there to combine the first 2 columns together, then use this code to combine first 2 columns :
Sub MergeColumns()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim LastRow As Long, i As Long
Set ws1 = Sheets("Your Sheet Name")
LastRow = ws1.Range("F" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If ws1.Range("G" & i) <> "" Then
ws1.Range("I" & i) = ws1.Range("H" & i).Text & "" & ws1.Range("G" & i).Text
Else: ws1.Range("I" & i) = ws1.Range("H" & i)
End If
Next i
End Sub
Obviously changing the sheet name and columns letter to suit your requirements.
I want to look through a table in a sheet. Find each cell with "Yes" in it, when one is found. Paste a Yes to A1, when another is found A2, etc...
I was trying to modify this code to search all cells instead of just Row A
Following code should give you the headstart
Sub Text_search()
Dim Myrange As Range
Set Myrange = ActiveSheet.UsedRange
For Each cell In Myrange
If InStr(1, cell.Value, "YES") > 0 Then
'do something
Else
'do something else
End If
Next
End Sub
Further to #isomericharsh's answer, if it's a table you're looking through, that simplifies defining the range; just use DataBodyRange.
If the table 'Table1' is on 'Sheet1' and the results are to be posted on 'Sheet2' then I'd do as follows:
Sub Search_for_Yes()
Dim YesAmt As Long ' - Amount of yes's found
YesAmt = 0 'to start with
Dim ws1 As Worksheet
Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet
Set ws2 = Sheets("Sheet2")
'It's always safer to use specific references rather than ActiveSheet
For Each cell In ws1.ListObjects("Table1").DataBodyRange 'The data in the table excluding headings and totals
If cell.Value = "YES" Then 'might need to add wildcards to this if you want to include cells that contain yes as part of larger text string. Also note that it's case-specific.
ws2.Cells(1 + YesAmt, 1).Value = "Yes" 'so that each time a yes is found it will log it further down
YesAmt = YesAmt + 1
End If
Next
x = MsgBox(YesAmt & " values found and listed", vbOKOnly + vbInformation)
End Sub
Does that help?
I want to select the entire column that contain the names to copy it knowing that the Name column number can change between a spreadsheet and another and there is some blank cells in the middle (missing value)
Suppose that the Names column is the column B, so if I want to select the entire column even with the some blank cells in the middle I can use the following code:
Range("B2", Range("B" & Rows.Count).End(xlup)).Select
But the Name column number is variable. so i tried to make it like this :
Sub ColSelection ()
Dim NameHeader As range
'To select the header of Name column
Set NameHeader = ActiveSheet.UsedRange.Find("Name")
ActiveSheet.Range(NameHeader.Offset(1,0), Range(NameHeader & Rows.Count).End(xlUp)).select
' run tim error 1004 " Methode 'Range' of object '_Global' Failed
End sub
I guess that I have to replace the second NameHeader with his column address. how to do that? Should I set a Var to store the address of the range NameHeader, and use it. If it's the case how should I set this var, I mean as long or as Variant..ect?
Thanks :)
Is this what you are trying? I have commented the code so you should not have a problem understanding it. But if you still do then post your query.
Is this what you are trying?
Sub ColSelection()
Dim NameHeader As Range
Dim ws As Worksheet
Dim ColName As String
Dim LRow As Long
Dim rng As Range
Set ws = Sheet1 '<~~ Change as applicable
With ws
Set NameHeader = .UsedRange.Find("Name")
'~~> Check if we found the text
If Not NameHeader Is Nothing Then
'~~> Get the Column Name
ColName = Split(Cells(, NameHeader.Column).Address, "$")(1)
'~~> Get the last row in that range
LRow = .Range(ColName & .Rows.Count).End(xlUp).Row
'~~> Construct your range
Set rng = .Range(ColName & NameHeader.Row & ":" & ColName & LRow)
With rng
MsgBox .Address
'~~> Do whatever you want with the range
End With
End If
End With
End Sub
Screenshot
Unable to upload an image, Imgur is rejecting images for the time being. Will update it directly later.
http://prntscr.com/kftsad
No need to look at NameHeader.Address - just use its .Column - something like this (noting that you don't have to Select a Range before copying.
Sub GrabNameCol()
Dim NameHeader As Range
Set NameHeader = ActiveSheet.UsedRange.Find("Name")
If Not NameHeader Is Nothing Then
ActiveSheet.Range(NameHeader.Offset(1), Cells(Rows.Count, NameHeader.Column).End(xlUp)).Select ' or just .Copy
End If
End Sub
Sub test1a()
Dim NameHeader As Range
Set NameHeader = ActiveSheet.UsedRange.Find(InputBox("HEADER"))
If Not NameHeader Is Nothing Then
ActiveSheet.Range(NameHeader.Offset(1), Cells(Rows.Count, NameHeader.Column).End(xlUp)).Select
End If
End Sub
I have the following VBA Function where it will find the info typed into the Input Box and deletes every row with that value.
How can I change it to delete all rows except for the value you enter. Example I enter 123. I want it to delete all rows except for the cells in column B with 123.
Sub DeleteRows()
Dim c As Range
Dim SrchRng As Range
Dim SrchStr As String
Set SrchRng = ActiveSheet.Range("B1", ActiveSheet.Range("B4343").End(xlUp))
SrchStr = InputBox("Please Enter Value")
Do
Set c = SrchRng.Find(SrchStr, LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing
End Sub
OK there may well be a better way to do this but I went with creating a temp sheet, copy in the rows that match your search, clear all rows in the sheet and finally copy back the rows that matched then delete the temp sheet:
Sub DeleteRows()
Dim c As Range, b As Range, SrchRng As Range, SrchStr As String, MasterSheet As Worksheet, TempSheet As Worksheet
Set MasterSheet = ActiveSheet
Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A4343").End(xlUp))
SrchStr = InputBox("Please Enter Value")
Worksheets.Add
Set TempSheet = ActiveSheet
MasterSheet.Select
Set c = SrchRng.Find(SrchStr, LookIn:=xlValues)
Set b = c
Do
If Not c Is Nothing Then
c.EntireRow.Copy
TempSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
End If
Set c = SrchRng.FindNext(After:=c)
If c.Address = b.Address Then Exit Do
Loop While Not c Is Nothing
Range("A2:A" & Rows.Count).EntireRow.ClearContents
TempSheet.Range("A2:A" & TempSheet.Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Copy
ActiveSheet.Range("A2:A" & TempSheet.Range("A" & Rows.Count).End(xlUp).Row).PasteSpecial xlPasteAll
Application.DisplayAlerts = False
TempSheet.Delete
Application.DisplayAlerts = True
End Sub
Hope that helps.
I started playing around trying to populate an array from the search results in one go without looping it but it didn't go well and I have run out of spare time to explore this further unfortunately. My idea was to try and populate an array from the results in one go, then select all rows minus anything in the joined array then delete. Not sure how possible that is but maybe explore it if you get time.
My Test data was using column A, you will need to change a few parts for column B.
I want to count number of rows in Sheet1, from the Sheet2 code module.
In the sheet1 code module, the following code works fine
ctr = Range("B2", Range("B2").End(xlDown)).Count
I tried the same code in the Sheet2 code module
recct = ThisWorkbook.Sheets("Sheet1").Range("B2", Range("B2").End(xlDown)).Count
I am getting run time error 1004 Application -Defined or Defined error
Thanks
The error occurs in the 2nd range reference in recct. Because you are referencing a different sheet, you need to tell VBA the sheet name in both range references.
Try this instead:
With ThisWorkbook.Sheets("Sheet1")
recct = .Range("B2", .Range("B2").End(xlDown)).Rows.Count
End With
Alternatively, this will work as well (though a bit sloppier).
recct = ThisWorkbook.Sheets("Sheet1").Range("B2", ThisWorkbook.Sheets("Sheet1").Range("B2").End(xlDown)).Rows.Count
Update
Since there is a lot of discussion around what you actually mean by number of rows on the sheet, use the above code to literally start at B2 and count the number of contiguous cells directly underneath
However, if you want to find the last "real" used cell in column B (by real, I mean with data in it) do this:
With ThisWorkbook.Sheets("Sheet1")
recct = .Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Rows.Count
End With
You can use this for example:
rowsInThere = Sheets("Sheet1").UsedRange.Rows.Count
This works without ranges. Also you might use ActiveSheet as a sheet to check, in case you would need to change current sheet and check its rows count.
Two things
When working off sheet you need to fully qualify your range
Always measure the last cell bottom up rather than top down - you may have gaps
code
Sub GetB()
Dim ws As Worksheet
Set ws = Sheets(1)
Dim lngCnt As Long
lngCnt = ws.Range(ws.[b2], ws.Cells(Rows.Count, "b").End(xlUp)).Count
End Sub
more robust
To handle all situations cleanly then Find is easier
Sub GetB()
Dim ws As Worksheet
Dim rng1 As Range
Set ws = Sheets(1)
Set rng1 = ws.Range("B:B").Find("*", ws.[b1], xlValues, , , xlPrevious)
If Not rng1 Is Nothing Then
Select Case rng1.Row
Case 1
MsgBox "Only B1 has data", vbCritical
Case 2
MsgBox "No used cells past B2"
Case Else
MsgBox rng1.Row - 1 & " cells between B2 and B" & rng1.Row
End Select
Else
MsgBox ws.Name & " column B Is blank", vbCritical
End If
End Sub
Don't know if this will help but I use this in my modules all the time:
Dim TR as long, TC as long
TR = [Sheet1!A1].CurrentRegion.Rows.count
TC = [Sheet1!A1].CurrentRegion.Columns.count
If I know that if the dataset I'm dealing with doesn't have an empty row or column, like an extract from another program or something, then it's quick and works great!
From this I can specify a range select or perform a vlookup.
TR = [Sheet1!A1].CurrentRegion.Rows.count
[I2] = "=vlookup($C2,'sheet1'!A$2:B$" & TR & ",2,FALSE)"