I have 2 excel files with a lot of data in each. The data is structured exactly the same in both files but the values might have changed as the data is from two different times.
Basically I want to find some way to automatically compare values in each cell for the two files and highlight the cells that have changed values in file #2.
Kindly share your ideas!
Example:
File 1 :
a / 1 / 2
File 2 :
a / 1 / 8
(/ - indicates new cell)
This may not be the most efficient way (can handle 25k cells in a few seconds, though), but it more than makes up for it in simplicity.
This will look at every cell in Sheet2 and compare it against the value in the cell at the same address in Sheet1 of the file you specify. If it's different, the cell in Sheet2 is highlighted yellow.
Sub FindDifferences()
Application.ScreenUpdating = False
Dim cell As Range
Dim wkb1 As Workbook
Dim wks1 As Worksheet
Set wkb1 = Workbooks.Open(Filename:="C:\MyBook.xls")
Set wks1 = wkb1.Worksheets("Sheet1")
For Each cell In ThisWorkbook.Sheets("Sheet2").UsedRange
If cell.Value <> wks1.Cells(cell.Row, cell.Column).Value Then
cell.Interior.Color = vbYellow
End If
Next
wkb1.Close
Application.ScreenUpdating = True
End Sub
Note:
You could easily tailor this to compare 2 sheets in the same file by simple removing the wkb1 and wks1 variables and changing wks1.Cells... to Sheets("Sheet1").Cells...
You can use this online website - xlcomparator.net (click on the flag on the top right for an english version).
Or try this software: http://www.formulasoft.com/excel-compare.html
Or try this kind of macro (that check the first column) and adapt it to your needs:
sub compare()
Application.ScreenUpdating = False
Dim coll1 As New Collection, coll2 As New Collection
Dim cell1 As Range, cell2 As Range
Dim Element1 As Object, Element2 As Object
Workbooks("workbook1.xls").Activate
For Each Cellule1 In Range("a:a")
coll1.Add cell1
Next Cellule1
Workbooks("workbook2.xls").Activate
For Each cell2 In Range("a:a")
coll2.Add cell2
Next cell2
For Each Element1 In coll1
For Each Element2 In coll2
If Element1 <> Element2 Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbBlack
Exit For
End If
Next Element2
Next Element1
Application.ScreenUpdating = True
end sub
Source - excelabo, a french website
Two further options:
Spreadsheet Advantage, http://www.spreadsheetadvantage.com/, where you can get a free 30 day trial
This is my favourite tool as it also offers a row and column alignment option to ensure both sheets are presented indentically by row and column, before running the compare outputs code to highlight any differences
Myrna Lawson's compare.xla addin (free) available at Chip Pearson's site http://www.cpearson.com/Zips/Compare.zip
Related
I have a template file, whereby multiple copies of the template (5 to 20) are completed, then consolidated into one master file. This file contains multiple sheets (18) and hundreds of entries in each sheet.
Not every cell is a number requiring consolidation, i.e there are titles and dates etc which are repeated, with no clear structure. Re-organising the template is not an option. The best way is to calculate only cells with a "Currency" type.
Here is the code I have so far. I have pieced it together from a number of searches, but will admit that I don't fully understand vba so I know I'm missing something obvious.
To make this a bit simpler, I have closed everything else and opened the target files manually before running this, then called upon the open excel files. Improving this bit of the code so that I can just put the target files into a sub folder and then use that path would be nice but not necessary.
I do not need to change the cell colour at the end, but I just did that as a quick visual reference to see whether it had ran.
The script in this format does not throw up any errors, but simply runs without actually calculating and populating the total value into each cell. I would guess that my approach of trying to extract the sheet and cell reference for every loop is wrong, but I cannot find the answer anywhere, so any help would be greatly appreciated.
totalValue = totalValue + Worksheets(sht).Cells(R, C)
is completely the wrong syntax, and the crux of the issue, but I simply don't know how to fix this within the context of the two existing For Each loops.
Sub ConsolidatedFigures()
Application.ScreenUpdating = False
'Declare variable types
Dim ws As Worksheet
Dim totalValue As Double
Dim C As Integer
Dim R As Integer
Dim wb As Workbook
Dim sht As String
Dim myRange As Range
Dim cell As Range
'Start to loop through each sheet in the workbook
For Each ws In ThisWorkbook.Worksheets
'get the current sheet name to later search for the same sheet in other workbooks
sht = ws.Name
'set the range in the current sheet
Set myRange = ws.UsedRange
'Now loop though every cell in the range
For Each cell In myRange
'Only target cells with an "currency" style so we're not trying to sum text
If cell.Style = "Currency" Then
'get the current cell references to later search for the same cell in other workbooks
C = cell.Column
R = cell.Row
'Within the current cell, go through open workbooks (except this one) to create a total of all the corresponding cells
For Each wb In Application.Workbooks
'the target workbooks will be open already, and nothing else. Disregard this open workbook and personal book
If wb.Name <> "PERSONAL.xlsb" AND wb.Name <> "consolidation.xlsm" Then
totalValue = totalValue + Worksheets(sht).Cells(R, C)
End If
Next wb
'populate the cell with the total of the corresponding cells
cell.Value = totalValue
'change cell colour to show the above step worked
cell.Interior.ColorIndex = 5
End If
'move on to next cell in worksheet
Next cell
'move on to next sheet in the workbook
Next ws
Application.ScreenUpdating = True
End Sub
I am trying to develop an index, but in order to make correct calculations and pivot tables, I need to merge some cells. Doing this manually would take a lot of time, therefore I am looking for a more efficient way. I assume a Macro might help me out here, yet I do not really know how to get started.
A bit of context on the datasheet: The info in cells E until AB was used to calculate the numbers in cells AC, AD, AE and AF. This information was hided as these cells do not need to be merged.
I am in the need of a macro that:
Merges the value in column A when the organization name is identical.
Merges the information in columns AC, AD, AE and AF when it refers to the same organization in column A.
Can somebody help me out? Thank you in advance for the help!!
https://i.stack.imgur.com/LShf3.png
This should be a result, but then accomplished with a macro so that it can be done efficiently for larger lists:https://i.stack.imgur.com/tm4RQ.png
Try this code:
Sub SubMerge()
'Declarations.
Dim RngName As Range
Dim RngFirstCat As Range
Dim DblTotalCat As Double
Dim DblCounter01 As Double
'Settings.
Set RngName = Range("A2")
Set RngFirstCat = Range("AC2")
DblTotalCat = 4
'Deactivating display alerts.
Application.DisplayAlerts = False
'Repeat until an empty cell is found.
Do Until RngName.Value = ""
'Repeat until a different value is found.
Do Until RngName.Offset(1, 0).Cells(RngName.Cells.Count, 1).Value <> RngName.Cells(1, 1).Value
'Increasing the size of RngName by 1 row.
Set RngName = RngName.Resize(RngName.Rows.Count + 1)
Loop
'Checking if RngName has more than 1 row.
If RngName.Rows.Count > 1 Then
'Setting RngFirstCat.
Set RngFirstCat = Cells(RngName.Row, RngFirstCat.Column).Resize(RngName.Rows.Count)
'Covering each category.
For DblCounter01 = DblTotalCat - 1 To 0 Step -1
'Merging the cells.
RngFirstCat.Offset(0, DblCounter01).Merge
Next
End If
'Setting RngName for the next value.
Set RngName = RngName.Cells(1, 1).Offset(RngName.Cells.Count)
Loop
'Deactivating display alerts.
Application.DisplayAlerts = True
End Sub
Is it possible to write a vba macro that determines if there are any empty cells in a given range and returns the row number of that cell?
I'm new to vba and all that I managed to write after searching the internet was something that takes a range and colors every emty cell in it red:
Sub EmptyRed()
If TypeName(Selection) <> "Range" Then Exit Sub
For Each cell In Selection
If IsEmpty(cell.Value) Then cell.Interior.Color = RGB(255, 0, 0)
Next cell
End Sub
The macro does basically what I want, but instead of coloring the empty cell red I would like to know the row index of the empty cell.
A little background info: I have a very large file (about 80 000 rows) that contains many merged cells. I want to import it into R with readxl. Readxl splits merged cells, puts the value in the first split cell and NA into all others. But a completely empty cell would also be assigned NA, so I thought the best thing would be to find out which cells are empty with Excel, so that I know which NA indicate a merged cell or an empty cell. Any suggestions on how to solve this problem are very welcome, thanks!
Edit: To clarify: Ideally, I want to unmerge all cells in my document and fill each split cell with the content of the previously merged cell. But I found macros on the web that are supposed to do exactly that, but they didn't work on my file, so I thought I could just determine blank cells and then work on them in R. I usually don't work with Excel so I know very little about it, so sorry if my thought process is far too complicated.
To do exactly what you state in your title:
If IsEmpty(cell.Value) Then Debug.Print cell.Row
But there are also Excel methods to determine merged cells and act on them. So And I'm not sure exactly what you want to do with the information.
EDIT
Adding on what you say you want to do with the results, perhaps this VBA code might help:
Option Explicit
Sub EmptyRed()
Dim myMergedRange As Range, myCell As Range, myMergedCell As Range
Dim rngProcess As Range
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set rngProcess = Range("A1:B10")
For Each myCell In rngProcess
If myCell.MergeCells = True Then
Set myMergedRange = myCell.MergeArea
With myMergedRange
.MergeCells = False
.Value = myCell(1, 1)
End With
End If
Next myCell
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End sub
Note that I explicitly declare all variables, and I hard coded the range to check. There are various ways of declaring the range to be checked; using 'Selection' is usually rarely preferred.
Before anything else: From the opposite end of the spectrum, you can use Range.MergeCells or Range.MergeArea to determine if a Cell is part of a Merged Area. But, I digress...
You can use Cell.Row to get the row number. How you return or display that is up to you - could be a Message Box, a delimited string, or an array, or even a multi-area range.
A Sub cannot return anything once called, so you may want a Function instead, e.g. Public Function EmptyRed() As String
(Also, I would recommend you get in the habit of explicitly declaring all of your variables, and perhaps using Option Explicit too, before you run into a typo-based error. Just add Dim cell As Range at the top of the sub for now)
Sub FF()
Dim r, wksOutput As Worksheet
Dim cell As Range, rng As Range, rngArea As Range
With Selection
.UnMerge
'// Get only blank cells
Set rng = .SpecialCells(xlCellTypeBlanks)
'// Make blank cells red
rng.Interior.Color = vbRed
End With
'// Create output worksheet
Set wksOutput = Sheets.Add()
With wksOutput
For Each rngArea In rng.Areas
For Each cell In rngArea
r = r + 1
'// Write down the row of blank cell
.Cells(r, 1) = cell.Row
Next
Next
'// Remove duplicates
.Range("A:A").RemoveDuplicates Array(1), xlNo
End With
End Sub
There are a couple ways:
Sub EmptyRed()
Dim rgn,targetrgn as range
Dim ads as string ‘ return rgn address
Set targetrgn= ‘ your selection
For Each rgn In Targetrgn
If IsEmpty(rgn.Value) Then
‘1. Use address function, and from there you can stripe out the column and row
Ads=application.worksheetfunction.addres(cell,1)’ the second input control the address format, w/o $
‘2. Range.row & range.column
Ads=“row:” & rgn.row & “, col: “ & rgn.column
End if
Next rgn
End Sub
Ps: I edited the code on my phone and will debug further when I have a computer. And I am just more used to use “range” rather than “cell”.
To clarify: Ideally, I want to unmerge all cells in my document and fill each split cell with the content of the previously merged cell.
Cycle through all cells in the worksheet's UsedRange
If merged, unmerge and fill the unmerged area with the value from the formerly merged area.
If not merged but blank, collect for address output.
Sub fillMerged()
Dim r As Range, br As Range, mr As Range
For Each r In ActiveSheet.UsedRange
If r.Address <> r.MergeArea.Address Then
'merged cells - unmerge and set value to all
Set mr = r.MergeArea
r.UnMerge
mr.Value = mr.Cells(1).Value
ElseIf IsEmpty(r) Then
'unmerged blank cell
If br Is Nothing Then
Set br = r
Else
Set br = Union(br, r)
End If
End If
Next r
Debug.Print "blank cells: " & br.Address(0, 0)
End Sub
So I have a big excel sheet with a bunch of empty cells in various locations. I want an easy to work with list of which cells are empty. I was hoping to make a new worksheet that was populated with the locations of the empty cells. I wanted to have this to just populate the cells I want it to. I kept the header from the worksheet I will be checking and added a blank cells count, so I want the following cells in the column to be populated by the list of empty cell locations.
Now I know I can use =ISBLANK to test if a cell is empty or not, but I only care about the cells that return TRUE. So I figure I'll need a loop. And I want the location of the cell so I can use =CELL. And to make this most readable I want to do this on a column by column basis.
But I want to populate a spreadsheet with this information in a manner similar to how functions work (I just want to copy and paste it to other cells and columns). But it's pretty clear that I am going to need VBA.
My question is how can I create a macro to populate my spreadsheet with a list of empty cells? How do I apply it to the cells?
I assume you have data in sheet1, I have used sample range// Range("A1:c15") however you can define range as per need and blank cells address will be published in next sheet.
Sub FindBlank()
Dim rng As Range
dim i as long
For Each rng In Sheet1.Range("A1:c15").SpecialCells(xlCellTypeBlanks)
i = i + 1
Sheet2.Cells(i, 1) = rng.Address
Next
End Sub
If you want a list of the cells that are empty, you can use Range().SpecialCells(xlCellTypeBlank):
Sub getEmptyCellAddresses()
Dim rng As Range
Dim ws as Worksheet
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15").SpecialCells(xlCellTypeBlanks) ' Edit/change range as necessary
ws.Cells(1, 2).Value = rng.Cells.Address ' Change `ws.cells(1, 2)` to whatever destination you like
End Sub
Edit: Ah, beaten by 16 seconds by #RamAnuragi ...but anyways, they're slightly different ways to tackle the question so I'll leave it.
Edit: For funsies, here's another way to put them all in a column, one row per cell...and more, per your comments.
Sub listEmptyCells()
Dim emptyAddresses() As String
Dim i As Long
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15")
If WorksheetFunction.CountBlank(rng) = 0 Then
MsgBox ("No empty cells in the range")
Exit Sub
End If
emptyAddresses() = Split(rng.SpecialCells(xlCellTypeBlanks).Address, ",")
For i = LBound(emptyAddresses) To UBound(emptyAddresses)
ws.Cells(i + 1, 2).Value = emptyAddresses(i)
Next i
End Sub
The problem that I'm facing is concerning Excel. I'm trying to extract rows with multiple columns out of sheets based on certain criteria. I've found some solutions regarding this, but nothing is really what I'm looking for or I can't change it to make it work. I'll try to explain the issue more detailed below using an example.
Situation:
8 sheets (named Sh1 to Sh8) with a list of tasks
Each sheet represents a kind of task (personal, work, ...)
Each sheet has the same format
Data is located starting from row 4 and between column A to K
Below the data is a row with total calculations
The data includes text, numbers and blank cells
Column D is the status of the task (C for completed, I for in progress, N for not started)
Style of the sheets is completely done by using conditional formatting
I would like something that checks those 8 sheets and copies all entries (including the blank cells) that are a certain status, being either C, I or N, to a new sheet, called "Filtering". The filtering sheet will have headers as well and the data should start at row 7.
When I started this, I came up with a formula (based on this) that copies all the entries of one sheet. I could filter it by putting C, I or N in the cell D4 on the filtering sheet.
{
=IFERROR(
INDEX(
Sh1!A$4:A$19;SMALL(
IF(
Sh1!$D$4:$D19=Filtering!$D$4;
ROW(Sh1!A$4:A$19)-ROW(Sh1!A$4)+1
);
ROWS(Sh1!A$4:Sh1!A4)
)
);
"")
}
As I said before, the data includes blank cells, so I changed the formula to the following to make sure the blank cells didn't turn into 0's:
{
=IFERROR(
IF(
INDEX(SAME AS ABOVE)="";
"";
INDEX(SAME AS ABOVE);
);
"")
}
Although this worked, I could only perform this on one sheet, and not on all eight. I could solve this by starting Sh2 at a lower row in the filtering sheet and do this for all other sheets, but that's not really what I'd like to get. I would really like to get to a continuous list that sums up all the not started, completed or in progress by changing that one cell D4 on the filtering sheet.
That's where I would like your suggestions. If it's possible to do this without VBA, I'd prefer that, since I sometimes use it in the online web application and macro's don't work there. If VBA is the only solution, obviously that'd be okay too.
On a side note: I tried VBA based on a code that I found here. (please have patience with me, I never coded before this) but it seems really slow to process this. Every time I run the macro, it takes more than 15 seconds to calculate this, although there are only 200 tasks that I currently have. The following was for getting all the completed tasks. I could easily make the others by changing the C to I or N. There was another problem where the whole sheet was removed, including my headers, so I'd have to put a range on the clear.
Sub ExtractList()
Dim ws As Worksheet
Dim destinationWorksheet As Worksheet
Dim columnD As Range
Dim c As Range
Dim count As Long
Set destinationWorksheet = ActiveWorkbook.Worksheets("Filtering")
destinationWorksheet.Cells.ClearContents
count = 1
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Sh1" Or ws.Name = "Sh2" Or ws.Name = "Sh3" Or ws.Name
= "Sh4" Or ws.Name = "Sh5" Or ws.Name = "Sh6" Or ws.Name = "Sh7" Or
ws.Name = "Sh8" Then
Set columnD = ws.Range("D:D") 'columnD
For Each c In columnD
If WorksheetFunction.IsText(c.Value) Then
If InStr(c.Value, "C") > 0 Then
c.EntireRow.Copy
destinationWorksheet.Cells(count, 1).PasteSpecial xlPasteValuesAndNumberFormats
count = count + 1
End If
End If
Next c
End If
Next ws
End Sub
Thanks already for reading through this and I'm looking forward to your suggestions.
Cheers,
Bart
The reason your code is taking too long to run is because you are looping through the entire column. You need to delimit the range to work with.
This solution:
• Allows the user to determine the extraction criteria using cell D4 in “Filtering” worksheet (Target)
• Sets the data ranges for each worksheet [Sh1, Sh2, Sh3, Sh4, Sh5, Sh6, Sh7, Sh8] (Source)
• Uses AutoFilter to select the data required and
• Posts the resulting ranges from all worksheets in the “Filtering” worksheet
It assumes that:
• All worksheets involved have the same structure and headers
• Headers are located at A6:K6 for Target worksheet and A3:K3 for Source worksheets (change as required)
Sub ExtractList()
Dim wshTrg As Worksheet, wshSrc As Worksheet
Dim sCriteria As String
Dim rDta As Range
Dim rTmp As Range, rArea As Range, lRow As Long
Rem Set Worksheet Target
Set wshTrg = ThisWorkbook.Worksheets("Filtering") 'change as required
Rem Clear prior data 'Header at row 6 & data starts at row 7 - change as required
With wshTrg
Rem Sets Criteria from Cell [D4] in target worksheet
sCriteria = .Cells(4, 4).Value2
.Cells(7, 1).Value = "X" 'To set range incase there is only headers
.Range(.Cells(7, 1), .UsedRange.SpecialCells(xlCellTypeLastCell)).ClearContents
End With
Rem Process each worksheet
lRow = 7
For Each wshSrc In ThisWorkbook.Worksheets
Select Case wshSrc.Name
Case "Sh1", "Sh2", "Sh3", "Sh4", "Sh5", "Sh6", "Sh7", "Sh8"
With wshSrc
Rem Clear AutoFilter
If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter
Rem Set Data Range
Set rDta = .Range(.Cells(3, 1), .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 11))
End With
With rDta
Rem Apply AutoFilter
.AutoFilter Field:=4, Criteria1:=sCriteria
Rem Set resulting range
Set rTmp = .Offset(1).Resize(-1 + .Rows.count).SpecialCells(xlCellTypeVisible)
Rem Clear Autofilter
.AutoFilter
End With
Rem Post Resulting range in target worksheet
For Each rArea In rTmp.Areas
With rArea
wshTrg.Cells(lRow, 1).Resize(.Rows.count, .Columns.count).Value = .Value2
lRow = lRow + .Rows.count
End With: Next: End Select: Next
End Sub
Suggest to read the following pages to gain a deeper understanding of the resources used:
Range Object (Excel), Range.Offset Property (Excel),
Range.SpecialCells Method (Excel),
Select Case Statement, Worksheet.AutoFilter Property (Excel),
Worksheet.AutoFilterMode Property (Excel), With Statement