I am completely new to Excel VBA, and I need to write code to do a simple task. I need to compare values in two different columns row by row, and see if the difference exceeds 50. If so, I need to highlight the entire row.
I program in other languages, so I have a basic understanding for how this works, but I have no clue how to navigate cells/view the content inside the cells. I tried this but it didn't work out (it would just highlight every single row). I simplified it to compare if values are equal or not, but to no avail (still everything is highlighted) Can anyone give me some help?
Dim strF0_col As Integer, sF0_col As Integer
Dim myRow, counter As Integer
Dim rEnd As Integer
Sub compare_F0()
rEnd = 100
strF0_col = 307
sF0_col = 317
counter = 0
For myRow = 2 To rEnd Step 1
Application.StatusBar = counter & "rows highlighted."
If (Cells(myRow, strF0_col).Value = Cells(myRow, sF0_col).Value) Then
Cells(myRow, strF0_col).EntireRow.Interior.ColorIndex = 28
End If
Next myRow
End Sub
Thanks in advance
Is there any reason to do not use Conditional Formatting, as #Doug Glancy suggested?
It worked quite fine here for me.
In case you want to give it a shoot, do as follows...
Choose the whole row
Open Conditional Formatting Menu (will depend on your Excel version. Anyway...)
Add the Rule =$KU2>$LE2+50
Set the format you want (maybe fill in yellow?)
Confirm
Copy format to other rows
Notice the row index (2, in this case) cannot have the $ symbol.
Hope it helps.
You probably don't want to highlight rows that are blank?
If so, use
If Cells(myRow, strF0_col).Value <> "" And _
Cells(myRow, strF0_col).Value = Cells(myRow, sF0_col).Value Then
As an aside, accessing cell values like this is quite slow. If you are only processing 100 rows then its fast enough, but if this number grows then you will find it slows down to a painful degree.
It is much faster to copy the range values to a variant array an then loop over that. Search SO for [Excel] "Variant Array" There are many answers that show how to do this and explain why it helps
Related
I have inherited a very large spreadsheet and am trying to migrate it to a database. The table has over 300 columns, many of which reference other columns.
By converting it to a table (ListObject) in Excel, I thought it would be easier to deconstruct the logic... basically turn the formula:
=CJ6-CY6
into
=[#[Sale Price]]-[#[Standard Cost]]
Converting it to a table worked great... unfortunately it didn't change any of the embedded formulas. They still reference the ranges.
I think I may notionally understand why -- if a formula references a value in another row, then it's no longer a primitive calculation. But for formulas that are all on the same row, I'm wondering if there is any way to convert them without manually going into each of these 300+ columns and re-writing them. Some of them are beastly. No joke, this is an example:
=IF(IF(IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6)))<0,0,IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6))))>GO6,GO6,IF(IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6)))<0,0,IF(HD6="",0,IF(HD6=24,0,IF(HD6="U",((FI6-(ES6*12))*$I6),($I6*FI6)*HS6)))))
And it's not the worst one.
If anyone has ideas, I'd welcome them. I'm open to anything. VBA included.
I would never use this to teach computer science, but this is the hack that did the trick. To keep things simple, I transposed header names and the corresponding column into A17:
And then this VBA code successfully transformed each range into the corresponding column property.
Sub FooBomb()
Dim ws As Worksheet
Dim r, rw, translate As Range
Dim col, row As Integer
Dim find, anchored, repl As String
Set ws = ActiveWorkbook.ActiveSheet
Set rw = ws.Rows(6)
Set translate = ws.Range("A17:B363")
For col = 12 To 347
Set r = rw.Cells(1, col)
For row = 363 To 17 Step -1
find = ws.Cells(row, 1).Value2 & "6"
anchored = "$" & find
repl = "[#[" & ws.Cells(row, 2).Value2 & "]]"
r.Formula = VBA.Replace(r.Formula, anchored, repl)
r.Formula = VBA.Replace(r.Formula, find, repl)
Next row
Next col
End Sub
Hard-coded and not scalable, but I'm not looking to repeat this ever again.
-- EDIT --
Word to the wise to help performance, especially with as many columns and formulas are in this spreadsheet.
Set Formula calculation to manual before
Check before the field exists before doing a replacement -- skipping happens more often than not
Program ran in a few seconds (minutes prior) before these changes:
If InStr(r.Formula, anchored) > 0 Then
r.Formula = VBA.Replace(r.Formula, anchored, repl)
End If
If InStr(r.Formula, find) > 0 Then
r.Formula = VBA.Replace(r.Formula, find, repl)
End If
After my formulas and macros run, Im looking to highlight the cells in my worksheet that are outputted as a "" (Result of an If Formula).
It is a dynamic range, and I am having difficulty finding a way to change the color of Just the cells with a space. Any ideas would be very helpful.
Dim cell As Variant
For Each cell In Sheets("[Sheet name here]").UsedRange.Columns("U").Cells
If InStr(cell.Value, "") = 0 Then
cell.Interior.ColorIndex = 15
End If
Next cell
End Sub
Then I basically repeated it for column "D", but it takes an unusually long time to complete...
Im thinking i can implement the
=LEN(??)=0 function, but not sure how to do so...
The reason it is running so slow is that you're calling Excel Object for every cell in your range. If column U has 1,000 cells that aren't empty then that is 1,000 calls to the Excel object model.
It is much faster to read the entire range into memory at one time and then process it in memory. This is very easy to do. The code below reads cells A1:A100 but the key difference is that it only calls the Excel Object one time (instead of 100 times).
Dim MyData As Variant
MyData = Range("A1:A100").Value
For your code you would do something like this ...
Dim MyData As Variant
Dim i As Long
MyData = ActiveSheet.UsedRange.Columns("U").Cells.Value
For i = 1 To UBound(MyData)
If (MyData(i, 1) = "") Then
'keep track of which cells need to be colored
End If
Next
If you have a lot of cells that need coloring, you will need to use a "non-contiguous" range selecting in order to perform this with one call to Excel's object model. See this article for more information Using VBA to select non-adjacent range
Thanks all. In this instance, I ended up modifying my formulas to actually generate a space " " instead of a null string, "" as #Scott Craner pointed out.
With a legitimate space, I just achieved the same results using conditional formatting, as #tigeravatar suggested.
Thank you all for the help, I really appreciate it !
I have a table with column A containing incrementing numerical values, and column B being a bunch of names. I need to filter the table according the names, and have column C update with the difference between the value in column A in the current row and the cell above..
For example, I'd like to have something like this
which,
when filtered according to the Name column, should update the difference like so
I have tried to use SUBTOTAL function in a few different ways but to no avail. Ideally it'd update once the filter in the table is changed. I tried to do this in VBA but so far I've gotten macro that only filters with the hard-coded filter criteria.
Solutions in either excel formulas/python/vba are all welcomed and greatly appreciated!
I apologise in advance if this question isn't up to standards as Im new here :) Thank you in advance!
#JvdV: This is the outcome of me trying to implement your formula, This is after filtering.
REVISED ANSWER
So after your explenation I have looked into a formula that will give you the difference of the current row B-value minus the B-value of occurance of the A-value before that.
=IFERROR(B2-LOOKUP(2,1/($A$1:A1=A2),$B$1:B2),0)
Taking your sample data, it would look like this:
Then when you apply the filter, it would look like this:
So with this workaround you dont have the correct value when no filter is applied, but in this case I assumed you are interested in the difference when it IS filtered!
The formula is entered in cell C2 and dragged down.
EDIT
If this is not the answer you'r after and you DO need the values when it is not filtered, make use of a UDF like below:
Public Function LastVisibleCell(CL As Range) As Long
Dim RW As Long, X As Long
RW = CL.Row - 1
On Error GoTo 1
If RW > 1 Then
For X = RW To 1 Step -1
If ActiveSheet.Rows(X).EntireRow.Hidden Then
Else
LastVisibleCell = Cells(CL.Row, 2).Value - Cells(X, 2).Value
Exit For
End If
Next X
Else
1: LastVisibleCell = 0
End If
End Function
Call it from cell C2 like: =LastVisibleCell(A2) and drag down. When you apply your filter, the cells will update.
Beware, this will take ages to update on large datasets!
After 3 days of intense (albeit ineffective) Google-ing, I finally came across this answer also on stack overflow.
However, as I'm working on a large set of data (>150,000 rows), the method in the question uses too much memory. Using VBA to paste the formulas into visible cells only does not seem to alleviate the problem.
Sub CopyPasteFormula()
Dim Ws As Worksheet
Dim LRow As Long
Dim PasteRng As Range
Set Ws = Worksheets("Translated Data")
Ws.Range("$D$2:$D$200000").AutoFilter Field:=4, Criteria1:="<>-", Operator:=xlFilterValues
LRow = Ws.Range("D" & Rows.Count).End(xlUp).Row
Set PasteRng = Ws.Range("A3:A" & LRow).SpecialCells(xlCellTypeVisible)
Ws.Range("A3").Copy
PasteRng.PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
End Sub
Above is my macro code to attempt reduce the memory use... Appreciate any feedback!
I would like to swap selected cell ranges within the same column without having automatically adjusted attached formulas in other columns. Those cell ranges will almost always be of unequal size.
I found a VBA code which does it for two selected cells, but im afraid that this wont help me much.
Sub SwapCells()
Dim sHolder As String
If Selection.Cells.Count = 2 Then
With Selection
sHolder = .Cells(1).Formula
If .Areas.Count = 2 Then ' Cells selected using Ctrl key
.Areas(1).Formula = .Areas(2).Formula
.Areas(2).Formula = sHolder
Else ' Adjacent cells are selected
.Cells(1).Formula = .Cells(2).Formula
.Cells(2).Formula = sHolder
End If
End With
Else
MsgBox "Select only TWO cells to swap", vbCritical
End If
End Sub
I know that another option would be to hold 'shift' when moving the cell ranges (works perfectly fine), but then all the attached formulas will change their reference which I dont want (e.g. if I have a formula referring to cell A1, and im swapping A1 somewhere, the formula will refer to A1's new position, but I want the formula to still refer to A1).
I think another option would be to use INDIRECT("G" & ROW()) to fix it, but since its a quite resource-intensive formula, Id love to see an alternative.
On top of that, the latter two options would not allow me to use tables (which Id prefer for other reasons) because you cant swap cells in tables. This is why Id strongly prefer a VBA option.
I hope you can help me, thank you! Maybe it is only necessary to adjust the VBA code a little.
Kind regards,
Marco
EDIT: If it is significantly easier to swap two equal cell ranges (e.g. encompassing 5 cells each), then it would also be a good solution.
Sub SwapTwoSelectedRanges()
Dim initialRng As Range
Set initialRng = Selection
If initialRng.Areas.Count <> 2 Then
Debug.Print "Select 2 areas!"
Exit Sub
End If
If initialRng.Areas(1).Cells.Count <> initialRng.Areas(2).Cells.Count Then
Debug.Print "The cells should be the same number!"
Exit Sub
End If
Dim intermediateRng As Variant
intermediateRng = initialRng.Areas(1).Cells.Value2
initialRng.Areas(1).Cells.Value2 = initialRng.Areas(2).Cells.Value2
initialRng.Areas(2).Cells.Value2 = intermediateRng
End Sub
Swaping two values is considered an easy task, if you are using an intermediate value. With the ranges, there are two important checks to perform, before swapping them:
Are the selected areas exactly 2;
Is the number of cells equal in every area;
Then with an intermediateRng as a 3. variable, the swap is made;
This would only work, if the Areas are per column. If the selection is made per row, then the results would not be as expected;
Concerning the swaping of the colors, if the colors of all the cells per area are exactly the same, this would work:
Dim intermediateRng As Variant
Dim intermediateClr As Variant
intermediateRng = initialRng.Areas(1).Cells.Value2
intermediateClr = initialRng.Areas(1).Cells.Interior.Color
With initialRng
.Areas(1).Cells.Value2 = .Areas(2).Cells.Value2
.Areas(1).Cells.Interior.Color = .Areas(2).Cells.Interior.Color
.Areas(2).Cells.Value2 = intermediateRng
.Areas(2).Cells.Interior.Color = intermediateClr
End With
However, if the colors of the cells per Area are not the same, then the easiest way is to copy+paste the first range to a separate range and work from there.
I have this piece of code which finds the excel row of an item from a list and deletes the items from a list. What I want... is to delete the Excel row as well.
The code is here
Private Sub imperecheaza_Click()
Dim ws As Worksheet
Dim Rand As Long
Set ws = Worksheets("BD_IR")
Rand = 3
Do While ws.Cells(Rand, 4).Value <> "" And Rand < 65000
If ws.Cells(Rand, 4).Value = gksluri.Value * 1 And ws.Cells(Rand, 5).Value = gksluri.List(gksluri.ListIndex, 1) * 1 Then
ws.Range(Rand, 1).EntireRow.Delete '(here I want to delete the entire row that meets the criteria from the If statement)
gksluri.RemoveItem gksluri.ListIndex
Exit Do
End If
Rand = Rand + 1
Loop
End Sub
Where I added ws.Range(Rand,1).EntireRow.Delete is where I want to delete the entire row but I don't know how to do it. What I want... if it finds the same value in a cell like in some selected item of my list to be able to remove both the entire row in excel and the item from the listbox. It works to remove the item from the listbox but I don't know how to remove the row as well
Chris Nielsen's solution is simple and will work well. A slightly shorter option would be...
ws.Rows(Rand).Delete
...note there is no need to specify a Shift when deleting a row as, by definition, it's not possible to shift left
Incidentally, my preferred method for deleting rows is to use...
ws.Rows(Rand) = ""
...in the initial loop. I then use a Sort function to push these rows to the bottom of the data. The main reason for this is because deleting single rows can be a very slow procedure (if you are deleting >100). It also ensures nothing gets missed as per Robert Ilbrink's comment
You can learn the code for sorting by recording a macro and reducing the code as demonstrated in this expert Excel video. I have a suspicion that the neatest method (Range("A1:Z10").Sort Key1:=Range("A1"), Order1:=xlSortAscending/Descending, Header:=xlYes/No) can only be discovered on pre-2007 versions of Excel...but you can always reduce the 2007/2010 equivalent code
Couple more points...if your list is not already sorted by a column and you wish to retain the order, you can stick the row number 'Rand' in a spare column to the right of each row as you loop through. You would then sort by that comment and eliminate it
If your data rows contain formatting, you may wish to find the end of the new data range and delete the rows that you cleared earlier. That's to keep the file size down. Note that a single large delete at the end of the procedure will not impair your code's performance in the same way that deleting single rows does
Change your line
ws.Range(Rand, 1).EntireRow.Delete
to
ws.Cells(Rand, 1).EntireRow.Delete
Better yet, use union to grab all the rows you want to delete, then delete them all at once. The rows need not be continuous.
dim rng as range
dim rDel as range
for each rng in {the range you're searching}
if {Conditions to be met} = true then
if not rDel is nothing then
set rDel = union(rng,rDel)
else
set rDel = rng
end if
end if
next
rDel.entirerow.delete
That way you don't have to worry about sorting or things being at the bottom.
Something like this will do it:
Rows("12:12").Select
Selection.Delete
So in your code it would look like something like this:
Rows(CStr(rand) & ":" & CStr(rand)).Select
Selection.Delete