Shading cells when row value changes, across multiple rows AND columns EXCEL - excel

I need to be able to
-compare row data for each column(from cell B2; to the end, ie. whole worksheet minus first row and column)
-if no data changes in said column; then highlight the column heading
-if data changes; highlight the first cell where the data is changing
please see example, keep in mind the excel sheets I have are much much larger, like huge, so using reference columns wont work, and multiple formulas for each column wont work either. I found this for single column and its great, =INDIRECT("A"&ROW())<>INDIRECT("A"&(ROW()-1)), but I can't apply this to over 100 columns, not practical. Please help.
Bahh, I wrote one myself, its not dynamic on the number of rows or columns yet, but it does the job, and I think I don't have to go through both rows and columns, but I couldn't figure out how to reference the cell positions otherwise fast enough. Better then RobB solution, flapping his gums.
Private Sub CommandButton1_Click()
Dim i As Long
Dim j As Long
Dim flag As Boolean
Columns().Font.Color = vbBlack
Rows().Interior.ColorIndex = 0
flag = False
For j = 2 To 120 'Must hard code number of columns
For i = 3 To 3300 'Must hard code numbe of rows
If Cells(i, j).Value <> Cells(i - 1, j) And Not IsEmpty(Cells(i, j).Value) Then
Cells(i, j).Interior.ColorIndex = 37
flag = True
Else
If flag Then
Cells(1, j).Interior.ColorIndex = 36
End If
End If
Next i
flag = False
Next j
End Sub

This sounds like a simple task for a macro - though this would require you to do something manually (eg press a key) to initiate the comparison.

Related

How to add serial number in "different size merged cells" which are positioned "alternatively" in excel using VBA?

As shown in image, I am trying to fill numbers in increasing order in alternate merged cells, which are different in size. So, I can't use autofill function of excel. But I want a macro so I can do it every time just hitting button once.
Note that I want numbers till the used range only.
I tried a lot to do it my self, but I am stuck now...Plz help the beginner, it's my third day in VBA.
This should do what you are looking for.
It will ignore non merged cells, I didn't see any in your screenshot that needed a number and were not merged so that shouldn't be an issue.
It uses column B to figure out the last row of your data.
Dim i As Long
Dim lr As Long
Dim counter As Long
counter = 1
With Sheet1 'Change to whatever your sheets code name is
lr = .Cells(.Rows.Count, 2).End(xlUp).Row 'If you want to use something other than column B, change the 2 to the right column index
For i = 2 To lr
If .Cells(i, 1).MergeCells = True Then
If .Cells(i, 1).MergeArea.Item(1).Address = .Cells(i, 1).Address Then
.Cells(i, 1) = counter
counter = counter + 1
End If
End If
Next i
End With

Best way to run macro for over 500K rows?

I have a file with a bunch of rows that contains data for certain part numbers from different configurations. Some of these part numbers are repeated throughout the file, and in those duplicated part numbers may contain certain data and some may not. I am trying to find the best way to determine the commonalities in the file for certain data. So for the commonalities, if one row has a value and another row is blank, the value for the nonblank row would be put into the blank row. And if the data on those two rows were different it would change the font color on the cell indicating that this part number two different unique values and should be checked.
Dim i, j, n As Long
Dim lr As Long
Dim moaf As Workbook
Dim sht As Worksheet
Application.ScreenUpdating = False
Set moaf = Workbooks("MOAF3.xlsb")
Set sht = moaf.Worksheets("Wire Data")
n = InputBox("What column # are you trying to fill in?: ")
lr = Cells(Rows.count, 2).End(xlUp).Row
For i = 2 To lr
lkup = Cells(i, 2).Value 'sets first lookup value
Fill = Cells(i, n).Value 'sets the first data value to compare
If Len(Fill) > 0 Then
For j = 2 To lr
lkup2 = Cells(j, 2).Value 'sets the second lookup value
Fill2 = Cells(j, n).Value 'sets the second value to compare
If lkup2 = lkup Then 'checks to see if p/ns are same
If Len(Fill2) = 0 Then 'checks to see if second value is blank
Cells(j, n).Value = Fill 'if value is blank the cell takes value of non blank cell
ElseIf Fill <> Fill2 Then 'checks to see if the values are non matching and non zero
Cells(i, n).Font.ColorIndex = 3 'changes font color of two cells
Cells(j, n).Font.ColorIndex = 3 'changes font color of two cells
End If
End If
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub
Doing this generally freezes my excel, where my computer has 32GB of RAM and is Windows10. Is there a better approach for my problem, or is it something that can be done without using a vba? I've done some research on a method without using vba, but with like sumifs, countifs but haven't really done any deep dives.
So, if I understand your question correctly, you start with following data:
ID Column_header
2 a
3 _BLANK_
4 _BLANK_
5 b
6 _BLANK_
And you want to turn this into:
ID Column_header
2 a
3 a
4 a
5 b
6 b
I know a very simple trick for that (I have put everything in column 'A' for explanation):
Select every cell inside that column
Goto (Ctrl+G) Special, Blanks
In the formula bar, type =A2 (you are currently located in 'A3', and you want to copy there the value of the cell just above it)
Press Ctrl+ENTER
You'll see that 'A2' gets copied into 'A3', 'A3' into 'A4' and 'A5' into 'A6' (the fact that this is done for all blank cells, is due to the Ctrl+ENTER).
Record this into a macro, and it will go much faster.
I already see a question popping up : "Ok, but what about the font colour I want to change?". Well, the newly filled cells are based on a formula, so the length of =FORMULATEXT() won't be zero. You use this as a basis for conditional formatting.
Good luck
The inner for loop just needs to start at i, that is:
for j = i to lr
This should roughly half the runtime.
Further performance enhencements:
Use .Value2 instead of .Value property.
Or even better, read in the entire columns into an array, work on that in VBA, then write the result back.

How can I calculate the sum of the numbers of two columns for only a portion of the rows?

Say I have an Excel sheet with 10,000 rows and two columns. All 20,000 cells are filled with numbers and there is no missing data. I want to have a third column, the values of which are the sum of Column A and Column B. For example, C70 = A70 + B70, and C82 = A82 + 82, and the like.
The only problem is I want to do it for only a portion of the rows, say from row 125 to row 8954. I don't care about the rest of the values. And I don't want to do it by dragging the grid using the mouse. Is that possible?
If you have access to SEQUENCE() (Currently only available to Office 365 Insiders) then yes it is possible:
=INDEX(A:A,SEQUENCE(1000,,ROW(),1))+INDEX(B:B,SEQUENCE(1000,,ROW(),1))
Where 1000 is the number of rows desired. Place the formula in the first cell desired and it will automatically fill the rest.
I believe you need some logic about what is going on, related to the start and end row.
You can use an if-statement or sumifs() for this... will do an if-statement so i can specify not meeting the requirements as null.
With Start row as 2 and end row as 4 (see image), you can use this formula, and drag it down to the bottom of all columns:
=IF(AND(ROW(A2)<=F$2,ROW(A2)>=E$2),SUM(A2:B2),"")
Notice in the image that C5 has no value; this is due to the conditions of the if-statement being false.
Another idea, a simple macro that will do what you want by asking the user what the starting and end row is.
Sub test()
Dim startrow As Integer 'variable to hold first row
Dim endrow As Integer 'variable to hold last row
startrow = InputBox("Enter the start row")
endrow = InputBox("Enter the end row")
'loops through you desired range calculating what you want
Dim i As Integer
For i = startrow To endrow
Cells(i, 4).Value = Cells(i, 1).Value + Cells(i, 2).Value
Next
End Sub
Just change the values to suit your needs in what cells you want to add up and where you want the sum to go.

How to cycle through merged cells (and populate values from a one-dimensional array)?

I would like to find a way how to cycle through merged cells, e.g. using a For...Next loop.
I could only manage to make it work like this:
Cells(1,1).Select
For i=1 to 6
Selection.Value = arrData(i)
Selection.Offset(0,1).Select
Next i
I hate using .Select - but if I use .Offset(0,i) it won't move from merged cell to merged cell, but just the number of columns from the original cell.
For more detail - I am copying values from a csv-like format into a nicer formatted output sheet, that is then supposed to be exported with bunch of merged cells.
There are multiple sections to the sheet but within each section there is a known amount of cells per row.
My only working solution without .Select is to use .Cells
Example:
For row=0 to 12
with rng.Offset(1,0)
.cells(row+1,1)=arrdata(1+(row*6))
.cells(row+1,3)=arrdata(2+(row*6))
.cells(row+1,7)=arrdata(3+(row*6))
.cells(row+1,9)=arrdata(4+(row*6))
.cells(row+1,14)=arrdata(1+(row*6))
.cells(row+1,16)=arrdata(1+(row*6))
End with
Next row
but this is pretty ardous.
EDIT: Here is a screenshot:
target area
The idea is that the amount of rows is completely flexible, depending on the transaction. So sometimes there is only one row, but can be anything really.
My code generates this section using relative references based on named ranges.
And then from the ugly sheet (where all information is stored in a single row) the values are fed into a one-dimensional array, then the array should be fed into the nice looking sheet.
If the sheet had no merged cells, the formula would look quite simple:
Dim i as integer, j as integer
Dim ws as worksheet: set ws = Worksheets("Printable")
'data array has already been filled with info in a linear order beforehand
k=1
For i=1 to item_qt 'number of cost items lines
For j=1 to item_col 'number of detail columns (in this section)
ws.Range("item_title").Offset(1,0).Cells(i,j).Value=data(k)
k=k+1
Next j
Next i
But because of the nature of this sheet - supposed to be printable and nicer on the eyes - I can't do that and have to find a way how to switch between the merged cells.
Hope this Edit cleared some things up.
I am also looking into the suggestions now to see if I can apply those somehow, but if anybody knows of something better, I am open for everything.
If you're stepping through merged columns, you could use something like
For i = startColumn To endColumn
If Cells(row,StartColumn).MergeArea.Columns.Count > 1 Then
'Do Stuff
i = i + Cells(row,StartColumn).MergeArea.Columns.Count - 1
End If
Debug.Print i
Next i
This will test for merged columns and then jump to the next column after the merge.
EDIT:
Seeing your data structure added in your edit, you could incorporate the MergeArea.Columns.Count method into your For j-Next j loop like
k=1
For i=1 to item_qt 'number of cost items lines
For j=1 to item_col 'number of detail columns (in this section) <-this will need to
'be the total number of columns, not just the number of
'detail fields
ws.Range("item_title").Offset(1,0).Cells(i,j).Value=data(k)
j = j + ws.Range("item_title").Offset(1,0).Cells(i,j).MergeArea.Columns.Count - 1
k=k+1
Next j
Next i
By searching for "excel find merged cells vba" Google comes up with:
How To Identify And Select All Merged Cells In Excel?
https://www.extendoffice.com/documents/excel/962-excel-select-merged-cells.html
Sub FindMergedcells()
'updateby Extendoffice 20160106
Dim x As Range
For Each x In ActiveSheet.UsedRange
If x.MergeCells Then
x.Interior.ColorIndex = 8
End If
Next
End Sub
and
2 Practical Methods to Find Merged Cells in Your Excel
https://www.datanumen.com/blogs/2-practical-methods-find-merged-cells-excel/
Sub FindMerge()
Dim cel As Range
For Each cel In ActiveSheet.Range(“A1:G13”)
If cel.MergeCells = True Then
‘change the color to make it different
cel.Interior.Color = vbYellow
End If
Next cel
End Sub

Speeding up a search and delete macro

I have a list containing three columns. The first column contains Names and the other two columns have numbers. The macro takes the first name(A1) and then searches down column A for another occurrence.
When it finds it, it deletes the entire row.It then goes to A2 and does the same thing agan. It works ok for about 500 entries, but using 3000 entries slows it down considerably. Is there a way to speed up this code?
Sub Button1_DeleteRow()
Dim i As Integer
Dim j As Integer
Dim Value As Variant
Dim toCompare As Variant
For i = 1 To 3000
Value = Cells(i, 1)
For j = (i + 1) To 3000
toCompare = Cells(j, 1)
If (StrComp(Value, toCompare, vbTextCompare) = 0) Then
Rows(j).EntireRow.Delete
End If
Next j
Next i
End Sub
If you are running xl07/10 then you can do this with a single line with Remove Duplicates. If you are running 03 then a solution with AutoFilter will be most efficient (I can provide this if you are on the older version)
Remove Duplicates
Manually
Select column A
Data .... Remove Duplicates
Expand selection
Select only column A to find duplicates on
Code
ActiveSheet.Range("$A$1:$A$3000").EntireRow.RemoveDuplicates Columns:=1, Header:=xlNo
To supplement #brettdj's answer, if you are running Excel 2003, you can do this using AdvancedFilter as follows:
Range("A1:A11").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Note: AdvancedFilter assumes that the first row of your range (row A in this example) contains column headers and will not include that row in the filtering.
To do this manually: Data > Filter > Advanced Filter... > Unique records only
Using Bretts technique is a good answer: but to answer your question about why does it take so long:
- Your macro is getting a value from over 4 million cells one by one. This is very slow.
- I don't see that your macro has switched off screenupdating and automatic calculation: every time a row is deleted the screen will refresh and Excel will recalculate. If you have not switched these off it is very slow.
This code should run a lot faster
Option Explicit
Sub Button1_DeleteRow()
Dim i As Long
Dim j As Long
Dim vArr As Variant
Dim iComp As Long
Dim Deletes(1 To 3000) As Boolean
Application.ScreenUpdating = False
iComp = Application.Calculation
Application.Calculation = xlCalculationManual
vArr = Range("a1:A3000")
For i = 1 To 3000
For j = (i + 1) To 3000
If (StrComp(vArr(i, 1), vArr(j, 1), vbTextCompare) = 0) Then
Deletes(j) = True
End If
Next j
Next i
For j = 3000 To 1 Step -1
If Deletes(j) Then Rows(j).EntireRow.Delete
Next j
Application.ScreenUpdating = True
Application.Calculation = iComp
End Sub
Sorting the data on column A would then make it trivial to identify and remove the duplicates in a single pass
In response to the comment below, I'll explain why sorting is a useful technique.
By sorting column A into order, duplicate removal simply becomes a matter of comparing adjacent entries in column A. You can then either delete the duplicate rows as you find them or flag them for later deletion.
The process should actually be a lot less tedious as you only have to sort the list (and sorting, being built-in, tends to be very fast) and then do one pass (instead of 4498500) through the list deleting/flagging as you go (obviously you need a subsequent clean-up pass if you go for flagging).
On the issue of changing the order of the list, start by adding an extra column (e.g. column D) and have D2 contain the value 2 (i.e. just the row number). A quick fill-down later and every row is numbered. After sorting and deleting/flagging, restoring the original order is just a matter of re-sorting on column D which could then be deleted.
I use this method when I have to perform some operation or other on the duplicates. In other words, column A has duplicate values but the values in columns B and C are meaningful (for example, I might want to sum these values from all of the entries relating to the specific value of column A). In many cases, however, it would be easier just to use SQL to achieve the same result

Resources