Excel VBA deleting certain rows with certain conditions - vba

I found a code online which works but I am failing to change it for my purpose. Each entry in my spreadsheet contains different formulas as well as an Iferror function with the aim of making cells with error messages appear as blank. For example lets say a cell E3 is dependent on cell F3 with a certain formula (for clarification lets say F3/2.5). It is obvious if there is no entry in cell F3 then an error message would display in cell E3. For this reason, I use the IFERROR function to display the cell as blank. The difficulty arises when I want to delete blank rows after a click on the macro button. However, since that cell does have an entry (a formula which in turn returns an error message), that cell does not delete. Also I need to run this code over 3 different selection ranges. Please can someone help! The code I found was from a different thread on this forum and is:
`sub foo()
dim r As Range, rows As Long, i As Long
Set r = ActiveSheet.Range("A1:Z50")
rows = r.rows.Count
For i = rows To 1 Step (-1)
If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
Next
End Sub`
Thanks Alot!

EDIT: If statement added to the autofilter as it was deleting a row when there were no blanks
You will want to set up a column in the spreadsheet with the following sumproduct:
=SUMPRODUCT((LEN(A1:F1)>0)*1)
This is calculating how many cells' values have a length more than 0 hence are not blank, you will need to adjust cell references accordingly as I tested on a small sample of fake data.
Following this you can just loop:
For i = rows To 1 Step (-1)
If Cells(i,"G") = 0 Then r.rows(i).Delete 'My formula is in column "G"
Next
Or set up an auto-filter and delete entire rows of the visible cells:
Dim lrow As Integer
If Not WorksheetFunction.CountIf(Range("G:G"), "0") = 0 Then
Range("A1:G1").AutoFilter
Range("A1:G1").AutoFilter Field:=7, Criteria1:="0"
lrow = Cells(rows.Count, 7).End(xlUp).Row + 1
Range("G2:G" & lrow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Range("A1:G1").AutoFilter
End If
The only problem with using a leading column to calculate for this is if you have a lot of data coming and going as you will need to replenish the formula, though you could use auto complete in the code i guess.

Related

IF() Multiple Cells are equal then "TRUE" with only taking number values in a range

I am trying to write a formula to take only number formats from a row to in order to use an IF formula that illicit the value of "No" if all cells are equal to each other.
See a snippet of my file here:
The problem I am having is that the formula is taking the blank cells (no formats) and counting them in the equation still, so all of my values are "Yes". How do I let my formula only calculate from cells that have numbers in them for each row? I have tried the IFNUMBER(), IFEMPTY() etc... but I am not sure I am employing these correctly e.g. nesting into my formula. I need to ignore the blanks in each row.
Note: I need to only take the cells with number values. I have cleared the contents of values of the rows that do not have number values.
Here is the equation that I currently have:
=IFERROR(IF(AND(ROUND($E2,3)=ROUND($F2,3),ROUND($F2,3)=ROUND($G2,3),ROUND($G2,3)=ROUND($H2,3),ROUND($H2,3)=ROUND($I2,3),ROUND($I2,3)=ROUND($J2,3),ROUND($J2,3)=ROUND($K2,3),ROUND($K2,3)=ROUND($L2,3),ROUND($L2,3)=ROUND($M2,3),ROUND($M2,3)=ROUND($N2,3)),"No","Yes"),"")
Note: this is taking blanks and counting them (as stated from above). It should produce a "Yes" if there are numbers different in the column and a "No" if there are no numbers differences. Currently, it is always producing a "Yes" because it is counting the blanks in the columns.
I am open to a vba solution as well, I have the following from code, but I do not know how to set the range for each row to only look for number formats:
Here is my vba code:
Dim arng As Range
Dim aworkrng As Range
Dim brng As Range
Dim bworkrng As Range
On Error Resume Next
Set aworkrng = Range("O2:O1550")
Set bworkrng = Range("E2:N1550")
Set brng = Range("E2:N2")
On Error Resume Next
For Each arng In aworkrng
If Not IsEmpty(brng.Value) Then
arng.Formula = _
"=IFERROR(IF(AND(ROUND(RC5,3)=ROUND(RC6,3),ROUND(RC6,3)=ROUND(RC7,3),ROUND(RC7,3)=ROUND(RC8,3),ROUND(RC8,3)=ROUND(RC9,3),ROUND(RC9,3)=ROUND(RC10,3),ROUND(RC10,3)=ROUND(RC11,3),ROUND(RC11,3)=ROUND(RC12,3),ROUND(RC12,3)=ROUND(RC13,3),ROUND(RC13,3)=ROUND(RC14,3)),""No"",""Yes""),"""")"
Range("O3").Select
End If
Next
If anyone can help me on this, I would great appreciate it!
Try:
=IF(MIN(E2:N2)=MAX(E2:N2),"No","Yes")

Copy rows based on cell value and paste on a new sheet

Check This
I need a help. I want to copy whole cell from A sheet name "Components" only if value in Column C is > 0 to a new Sheet name "Load list"
Can someone please give me the macro code for this?
on your new sheet you can add this condition the cell or range of cells:
=IF(Components!C5>0,Components!A5)
where C5 has thevalue to compare, and A5 has the value copy if the condition happens.
Right in my swing!
The formula given by #sweetkaos will work fine, in case you want to replicate the data as it is with blanks where data is not found.
I will imagine a slightly more complicated situation. I am assuming you want just one line in the next format as is shown in your image.
Also conveniently assuming the following:
a. both sheets have fixed start points for the lists
b. 2 column lists - to be copied and pasted, with second column having value
c. Continuous, without break source list
d. basic knowledge of vba, so you can restructure the code
Here is the code. Do try to understand it line by line. Happy Excelling!
Sub populateLoadList()
'declaring range type variables
Dim rngStartFirstList As Range, rngStartLoadList As Range
'setting values to the range variables
'you must change the names of the sheets and A1 to the correct starts of your two lists
Set rngStartFirstList = Worksheets("Name_of_your_fist_sheet").Range("A1")
Set rngStartLoadList = Worksheets("Name_of_your_second_sheet").Range("A1")
Do While rngStartFirstList.Value <> ""
If rngStartFirstList.Offset(1, 0).Value < 0 Then
Range(rngStartFirstList, rngStartFirstList.Offset(0, 1)).Copy
rngStartLoadList.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Set rngStartLoadList = rngStartLoadList.Offset(1, 0)
End If
Set rngStartFirstList = rngStartFirstList.Offset(1, 0)
Loop
End Sub
Basically what i want is ... if Value on C is >0 i want whole column 10 copied to that new sheet .... not only that cell

Adjust criteria to depend on multiple values

I have been working on a code to copy the data from one specific range(always the same) and paste in another spreadsheet always in the row below. So basically, it starts pasting on row 11, but if I run again it will paste on the row 12 and there it goes.. The code has been working fine, but there is only one problem. It identifies the next empty row(to paste) based on the value of the column AP, but i want it to identify based on the values of all the columns between AP:BA. Thus, if there is any value on those cells, it should copy on the row below, not only if there is a value on AP. Does someone know how to change my code in order to solve this problem? Thank You very much
Sub Copy_Shanghai()
Dim count As Integer
count = 11
Do While Worksheets("Time Evolution").Range("AP" & count).Value <> ""
'<>"" means "is not empty", as long as this happens we go down looking for empty cell
count = count + 1
Loop
'Now count is row with first empty cell outside of top 10 rows in column C
Worksheets("Fill").Range("E5:P5").Copy
Worksheets("Time Evolution").Range("AP" & count).PasteSpecial xlPasteValues
End Sub

Excel: Check if cell string value exists in column, and get all cell references to that string

I suspect this may be a job for VBA, which is beyond my abilities. But here's the scenario:
Column A in Sheet 1 (CAS1) contains x rows of text values
Column A in Sheet 2 (CAS2) contains x rows of text values
Part A - For each row value in CAS1, I need to know if the string is contained in any of the cells in CAS2. Not exact match, the string can be only part of the searched cells.
Part B - I need to know the cell value of each cell in CAS2 that contains the CAS1 value (if they do exist, they can be listed in the cells adjacent to the cell being searched in CAS1).
I've tried the following to attempt Part A, all to no avail:
vlookup(A1,sheet2!A:A,1,false)
NOT(ISNA(MATCH(A1,sheet2!A:A,0)))
ISNUMBER(MATCH(A1,sheet2!A:A,0))
COUNTIF(sheet2!A:A,A1)>0
IF(ISERROR(MATCH(A1,sheet2!A:A, 0)), "No Match", "Match")
I know some of the cell values in CAS2 contain the cell values in CAS1, so I don't know why they return false or No Match. I suspect it may be down to the nature of the text content. So here's some sample data:
CAS1
LQ056
RV007H
RV008
RV009H
TSN304
TSN305
CAS2
RV009-satin-nickel-CO.jpg
STR314.jpg
STR315.jpg
HCY001.jpg
RV008-oval-rad-CO.jpg
HCY001-BRAC006.jpg
Any help would be appreciated.
This problem can be faced through VBA (at least, I imagine the VBA solution much more easily than the possible Excel one). You need a macro that, for each row in CAS1, search the content in each row of CAS2 and returns you the address.
For Each cell In Sheets("CAS1").Range("A1:A" & Sheets("CAS1").Range("A1").End(xlDown).Row) '<-- check each cell of the range A1:A? of sheet CAS1 (adapt "A" and "1" if they're different)
recFound = 0 '<-- count how many findings there are
For Each cell2 In Sheets("CAS2").Range("A1:A" & Sheets("CAS2").Range("A1").End(xlDown).Row) '<-- check in each cell of the range A1:A? of sheet CAS2 (adapt "A" and "1" if they're different)
If InStr(cell2.Value, cell.Value) <> 0 Then '<-- if the value in cell is contained in the value in cell2..
recFound = recFound + 1 '<-- account the new finding
cell.Offset(0, recFound) = Split(cell2.Address, "$")(1) & Split(cell2.Address, "$")(2) '<--write the address on the right of the currently searched cell
End If
Next cell2
Next cell
All the above should be enclosed in a macro, e.g. Sub makeMySearch(), that should be run to get the results. As commented in my code, I'm assuming that data are in A1:A? of both sheets; but they of course might be, for example, in B5:B? of the sheet 1 and in C7:C? of the sheet 2. You need clearly to adapt the code to your current data.
There's no need for VBA. Some simple array-formulas can do the job.
To see if the entry in CAS1 is present in CAS2:
=OR(ISNUMBER(SEARCH(A2,CAS2_)))
will return TRUE or FALSE. BUT this formula has to be entered by holding down CTRL-SHIFT while hitting ENTER If you do this correctly, Excel will place braces {...} around the formula that you can see in the formula bar.
The SEARCH function returns an array of results, which will be either the #VALUE! error, or a number.
In order to return the address, the following array-formula can be entered adjacent to a cell in CAS1:
=IFERROR(ADDRESS(LARGE(ISNUMBER(SEARCH($A2,CAS2_))*ROW(CAS2_),COLUMNS($A:A)),1),"")
Fill right for the maximum number of addresses possible, then select the group and fill down.
In this case, the array being returned is a string of either 0's, or 1 * the row number (i.e. the row number). I assumend the data in CAS2 was in column A, but you can change the column number if needed (or even compute it if necessary, by replacing the 1 in the ADDRESS function with COLUMN(CAS2_))
CAS1_ and CAS2_ are either named ranges, or absolute range references to the two text groups.

Getting a total copied set of rows in VBA and storing it in a variable

I have a fairly simple syntax question:
I'm trying to copy and paste n rows from one excel file to another. In addition, I'd like to store the total copied rows into a variable.
Can someone help me accomplish this?
For example:
1)
Activate CSV file
Apply Filter to Column B (Page Title) & uncheck "blanks" ("<>") filter**
Windows("Test_Origin.xlsm").Activate
ActiveSheet.Range("$A$1:$J$206").AutoFilter Field:=2, Criteria1:="<>"
2)
Copy Filtered Lines with data (Excluding Row 1)
Range("B2:F189").Select
Selection.Copy
copiedRowTotal = total *FILTERED* rows copied over from original sheet, then Test Number iterates that many times
copiedRowTotal = Selection.Rows.Count
MsgBox copiedRowTotal
Thanks
An indirect way to do this is
Range("B2:F189").Copy
Range("M2").PasteSpecial xlPasteValues
copiedRowTotal = Selection.Rows.Count
Selection.Clear
The code copies the range & does a paste special operation on a separate location.
By doing this, only filtered rows are copied to M2 & the area (where the filtered rows are pasted) is highlighted when PasteSpecial operation is done.
Doing a Selection.Rows.Count gives one, the number of filtered rows that were pasted.
After figuring out the number of filtered rows, the selection is cleared up.
I don't believe there is a way to get the visible cell count directly. I tried using the 'SpecialCells(xlSpecialCellsVisible)' function, but could not get the correct count with a filter applied. Here is a quick function I wrote that works with a filter applied.
Also be aware that sometimes a filter can mess with the selected range at times, so it's something to note.
Public Sub TestIt()
Dim visibleCount As Long
visibleCount = GetVisibleCount(Sheets(1).Range("A2:H3000"))
MsgBox visibleCount
End Sub
Public Function GetVisibleCount(rng As Range) As Long
Dim loopRow As Range
GetVisibleCount = 0
For Each loopRow In rng.Rows
If loopRow.Hidden = False Then
GetVisibleCount = GetVisibleCount + 1
End If
Next loopRow
End Function
copiedrowtotal = selection.rows.count ' its not selection.totalcells
I think this would do the trick
After seeing your update let me tell you probably these would work
dim i as long
i = Application.WorksheetFunction.Subtotal(2,worksheets("Sheet").Range("B2:F189"))
Now i has the number of filtered rows in it! If you have included header in your range then do -1 at the end else just leave it up
argument 2 in subtotal is => counting the rows and then sheet name
and then specify range to count filtered rows
instead I would select only one column if you applied filter for many columns!
Hope it helps dont forget to accept an answer ! :