compare cells in tabs - excel

I'm trying to compare cells in 2 tabs (master and test) and if there are changes in test then color changes in any kind of color and copy & paste it to master file.
UPDATED:
Here is required code
Sub test()
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
Dim jRow As Long
Dim jCol As Long
strRangeToCheck = "A1:V1000"
' If you know the data will only be in a smaller range, reduce the size of the ranges above.
Debug.Print Now
varSheetA = Worksheets("Sheet1").Range(strRangeToCheck)
varSheetB = Worksheets("Sheet2").Range(strRangeToCheck) ' or whatever your other sheet is.
Debug.Print Now
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetB(iRow, iCol) = varSheetA(iRow, iCol) Then
' Cells are identical.
' Do nothing.
Else
Sheets("Sheet1").Select
Cells(iRow, iCol).Interior.ColorIndex = 44
Sheets("Sheet2").Select
Cells(iRow, iCol).Interior.ColorIndex = 44
Sheets("Sheet2").Select
Cells(iRow, iCol).Copy
Sheets("Sheet1").Select
Cells(iRow, iCol).PasteSpecial xlValues
Cells(iRow, iCol).PasteSpecial xlFormats
' Cells are different.
' Code goes here for whatever it is you want to do.
End If
Next iCol
Next iRow
MsgBox ("Done")
End Sub

Find the last used cell in one of the worksheets.
dim lr as long, lc as long
lr= application.max(dWS.cells.specialcells(xlCellTypeLastCell).row, _
mWS.cells.specialcells(xlCellTypeLastCell).row)
lc= application.max(dWS.cells.specialcells(xlCellTypeLastCell).Column, _
mWS.cells.specialcells(xlCellTypeLastCell).Column)
For Each c In dWS.Range("A2", dWS.cells(lr, lc))
If Not dWS.Cells(c.Row, c.Column).Value = mWS.Cells(c.Row, c.Column).Value Then
dWS.Cells(c.Row, c.Column).Interior.Color = vbYellow
End If
Next

Related

How to compare two sheets in excel

Could any one help me with a code to compare two excel sheets and return the differences to a new sheet with the corresponding headers in VBA.??
need to modify this code to get the header section included while the mismatching values are returned.!!
Sub Compare_Two_Excel_Sheets_Highlight_Differences()
'Define Fields
Dim OutputLastRow As Long
Dim iRow As Double, iCol As Double, oRow As Double
Dim iRow_Max As Double, iCol_Max As Double
Dim sh1 As Worksheet, sh2 As Worksheet
Dim shOut As Worksheet
'Sheets to be compared
Set sh1 = ThisWorkbook.Sheets(1)
Set sh2 = ThisWorkbook.Sheets(2)
Set shOut = ThisWorkbook.Sheets(3)
'Max Rows
iRow_Max = sh1.UsedRange.Rows.Count
iCol_Max = sh1.UsedRange.Columns.Count
'Read Data From Each Sheets of Both Excel Files & Compare Data
For iRow = 1 To iRow_Max
For iCol = 1 To iCol_Max
sh1.Cells(iRow, iCol).Interior.Color = xlNone
sh2.Cells(iRow, iCol).Interior.Color = xlNone
'Compare Data From Excel Sheets & Highlight the Mismatches
If sh1.Cells(iRow, iCol) <> sh2.Cells(iRow, iCol) Then
sh1.Cells(iRow, iCol).Interior.Color = vbYellow
sh2.Cells(iRow, iCol).Interior.Color = vbYellow
'Write Differences to Output sheet
oRow = oRow + 1
shOut.Cells(oRow, 1) = sh1.Cells(iRow, iCol)
shOut.Cells(oRow, 2) = sh2.Cells(iRow, iCol)
End If
Next iCol
Next iRow
'Process Completed
MsgBox "Task Completed"
End Sub

Join text into one cell in various row and column

I have a spreadsheet that has values that looks similar to below :
Is there any possible way to create VBA to join all the separate data together for each ID and Class into one row? So that the ending result would look like below?
Sub JoinRowsData()
Dim lastRow As Long, i As Long, j As Long, k As Long
Application.ScreenUpdating = False
lastRow = Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
For j = i + 1 To lastRow
If Cells(i, 2) = Cells(j, 2) Then
For k = 5 To 10
If (Cells(i, k) = "" And Cells(j, k) <> "") Then
Cells(i, k) = Cells(j, k)
End If
Next
End If
Next
Next
Application.ScreenUpdating = True
End Sub
The following will do it. See the comments for an explanation how it works. It uses arrays to process the data which is much faster than process cells directly.
Option Explicit
Public Sub JoinRowsData()
Dim ws As Worksheet ' define worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long ' get last used row in worksheet
LastRow = GetLastUsed(xlByRows, ws)
Dim LastCol As Long ' get last used column in worksheet
LastCol = GetLastUsed(xlByColumns, ws)
' Read data into an array for faster processing
Dim Data() As Variant
Data = ws.Range("A1", ws.Cells(LastRow, LastCol)).Value2
' define an output array with the same size
Dim Output() As Variant
ReDim Output(1 To UBound(Data, 1), 1 To UBound(Data, 2))
Dim outRow As Long ' output row index
Dim iRow As Long
For iRow = 1 To LastRow ' loop through all rows in data
' if column 1 contains data it is a new output row
If Data(iRow, 1) <> vbNullString Then
outRow = outRow + 1
End If
' loop through all columns in a data row
Dim iCol As Long
For iCol = 1 To LastCol
If Data(iRow, iCol) <> vbNullString Then ' check if current cell has data
If Output(outRow, iCol) <> vbNullString Then
' add a line break if there is already data in the output cell
Output(outRow, iCol) = Output(outRow, iCol) & vbLf
End If
' add the data to the output cell
Output(outRow, iCol) = Output(outRow, iCol) & Data(iRow, iCol)
End If
Next iCol
Next iRow
' write all the output data from the array back to the cells
ws.Range("A1", ws.Cells(LastRow, LastCol)).Value2 = Output
End Sub
' find last used row or column in worksheet
Public Function GetLastUsed(ByVal RowCol As XlSearchOrder, ByVal InWorksheet As Worksheet) As Long
With InWorksheet
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
Dim LastCell As Range
Set LastCell = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=RowCol, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If RowCol = xlByRows Then
GetLastUsed = LastCell.Row
Else
GetLastUsed = LastCell.Column
End If
Else
GetLastUsed = 1
End If
End With
End Function

How can I write VBA to compare every cell on one sheet to every shell on another sheet?

I am trying to compare each cell on one sheet to each cell on another sheet and then highlight the differences. For example, I want to see if cell a2 on one sheet is the same as cell a2 on another sheet. At one point, I was able to run a comparison, but it was just looking for a match within the whole sheet, not just specific cells, so I was getting false positives. I am obviously missing the piece that makes the cell to cell comparison. New to VBA so here is what I have cobbled together so far:
Option Explicit
Sub test()
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
Dim cell As Variant
strRangeToCheck = "A1:Z5000"
Debug.Print Now
varSheetA = Worksheets("RoboReader").Range(strRangeToCheck)
varSheetB = Worksheets("Uploader").Range(strRangeToCheck)
Debug.Print Now
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
' Cells are identical.
' Do nothing.
Else
Cells.Font.Bold = True
Cells.Font.ColorIndex = 2
Cells.Interior.ColorIndex = 8
Cells.Interior.Pattern = xlSolid
End If
Next iCol
Next iRow
End Sub
Cell by Cell Comparison
When using Cells without a qualifier, it means all (1048576*16384)
cells on the Activesheet.
When you use the equal sign (=) in an If statement, the opposite
is (<>). You can eliminate the equal part since nothing will be
happening then.
A Quick Fix
Option Explicit
Sub test()
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
Dim cell As Variant
'Worksheets("Uploader").Cells.ClearFormats
strRangeToCheck = "A1:Z5000"
Debug.Print Now
varSheetA = Worksheets("RoboReader").Range(strRangeToCheck)
varSheetB = Worksheets("Uploader").Range(strRangeToCheck)
Debug.Print Now
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) <> varSheetB(iRow, iCol) Then
With Worksheets("Uploader").Cells(iRow, iCol)
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 8
.Interior.Pattern = xlSolid
End With
End If
Next iCol
Next iRow
End Sub

Comparing two workbooks with 80 sheets each

I am trying to write a script that will compare two workbooks that each have 80 sheets. The sheet names will match in both workbooks (one workbook is a prod copy, one is a copy from a UAT environment. All data should be same). I was able to run a script that will compare the sheet I specify, but I'm having difficulty trying to figure out how to write it to compare each sheet.
Sub CompareWorksheets()
Dim varSheetA As Worksheet
Dim varSheetB As Worksheet
Dim varSheetAr As Variant
Dim varSheetBr As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
Dim wbkc As Workbook
Set wbkc = ThisWorkbook 'this is where results of comparison will be documented
Set wbka = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard1.xlsx") 'PROD
Set wbkb = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard2.xlsx") 'UAT
Set varSheetA = wbka.Worksheets("Members")
Set varSheetB = wbkb.Worksheets("Members")
strRangeToCheck = ("A5:A10")
varSheetAr = varSheetA.Range(strRangeToCheck).Value
varSheetBr = varSheetB.Range(strRangeToCheck).Value
erow = 6 'starting row to document summary results
For iRow = LBound(varSheetAr, 1) To UBound(varSheetAr, 1)
For iCol = LBound(varSheetAr, 2) To UBound(varSheetAr, 2)
If varSheetAr(iRow, iCol) = varSheetBr(iRow, iCol) Then
varSheetA.Cells(iRow, iCol).Interior.ColorIndex = xlNone
varSheetB.Cells(iRow, iCol).Interior.ColorIndex = xlNone
Else
varSheetA.Cells(iRow, iCol).Interior.ColorIndex = 22
varSheetB.Cells(iRow, iCol).Interior.ColorIndex = 22
wbkc.Activate
erow = erow + 1
wbkc.Sheets("Summary").Cells(erow, 2) = iRow
wbkc.Sheets("Summary").Cells(erow, 3) = iCol
wbkc.Sheets("Summary").Cells(erow, 4) = varSheetA.Cells(iRow, iCol)
wbkc.Sheets("Summary").Cells(erow, 5) = varSheetB.Cells(iRow, iCol)
End If
Next
Next
End Sub
You need to iterate through the Worksheets of one of the workbooks and use the worksheet names to set worksheet variable for the second workbook.
Sub CompareWorksheets()
Dim wbPROD As Workbook, wbUAT As Workbook, wbSummary As Workbook
Dim wsPROD As Worksheet, wsUAT As Worksheet, wsSummary As Worksheet
Dim arrPROD As Variant, arrUAT As Variant
Dim strRangeToCheck As String
Dim iRow As Long, iCol As Long
Set wbSummary = ThisWorkbook 'this is where results of comparison will be documented
Set wsSummary = wbkc.Sheets("Summary")
Set wbPROD = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard1.xlsx") 'PROD
Set wbUAT = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard2.xlsx") 'UAT
strRangeToCheck = ("A5:A10")
erow = 6 'starting row to document summary results
For Each wsPROD In wbPROD.Worksheets
Set wsUAT = wbUAT.Worksheets(wsPROD.Name)
arrPROD = wsPROD.Range(strRangeToCheck).Value
arrUAT = wsUAT.Range(strRangeToCheck).Value
For iRow = LBound(arrPROD, 1) To UBound(arrPROD, 1)
For iCol = LBound(arrPROD, 2) To UBound(arrPROD, 2)
If arrPROD(iRow, iCol) = arrUAT(iRow, iCol) Then
wsPROD.Cells(iRow, iCol).Interior.ColorIndex = xlNone
wsUAT.Cells(iRow, iCol).Interior.ColorIndex = xlNone
Else
wsPROD.Cells(iRow, iCol).Interior.ColorIndex = 22
wsUAT.Cells(iRow, iCol).Interior.ColorIndex = 22
wbkc.Activate
erow = erow + 1
With wsSummary
.Cells(erow, 2) = iRow
.Cells(erow, 3) = iCol
.Cells(erow, 4) = wsPROD.Cells(iRow, iCol)
.Cells(erow, 5) = wsUAT.Cells(iRow, iCol)
End With
End If
Next
Next
Next
End Sub
Start with
Option Explicit ' to force you to declare for each variable
Add code to delete prior errors
Dim wbkc As Workbook, LastRow as Long, nRow as Long
wbkc.Sheets("Summary").UsedRange 'Refresh UsedRange
LastRow = wbkc.Sheets("Summary").UsedRange.Rows(wbkc.Sheets("Summary").UsedRange.Rows.Count).Row
For nRow = LastRow to eRow + 1 step -1
wbkc.Sheets("Summary").Rows(nRow).Delete
Next nRow
Basically, google "excel vba for each sheet" and look at the first one
https://stackoverflow.com/questions/21918166/excel-vba-for-each-worksheet-loop
to get the driving code (ignoring resizingColumns) and create CompareCells.
Sub forEachWs()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Call CompareCells(ws)
Next
End Sub
Sub CompareCells(ws as Worksheet)
End Sub
Finally, Add your code inside of CompareCells
Giving (PLEASE test this code, since we do not have wbka or wbkb excel files)
Option Explicit ' to force you to declare for each variable
' define output -- this is where results of comparison will be documented
Dim wbkc As Workbook, eRow as long, LastRow as Long, nRow as Long
Set wbkc = ThisWorkbook
eRow = 6 'starting row to document summary results
wbkc.Sheets("Summary").UsedRange 'Refresh UsedRange
LastRow = wbkc.Sheets("Summary").UsedRange.Rows(wbkc.Sheets("Summary").UsedRange.Rows.Count).Row
For nRow = LastRow to eRow + 1 step -1
wbkc.Sheets("Summary").Rows(nRow).Delete ' delete prior errors
Next nRow
' define inputs --
Dim wbka As Workbook, wbkb As Workbook
Set wbka = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard1.xlsx") 'PROD
Set wbkb = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard2.xlsx") 'UAT
' step thru each sheet
Dim ws As Worksheet
For Each ws In wbka.Worksheets
'
Dim varSheetA As Worksheet, varSheetB As Worksheet
Dim varSheetAr As Variant, varSheetBr As Variant
Dim strRangeToCheck As String
Set varSheetA = wbka.Worksheets(ws.Name)
Set varSheetB = wbkb.Worksheets(ws.Name)
strRangeToCheck = ("A5:A10")
varSheetAr = varSheetA.Range(strRangeToCheck).Value
varSheetBr = varSheetB.Range(strRangeToCheck).Value
' step thru each cell
Dim iRow As Long, iCol As Long
For iRow = LBound(varSheetAr, 1) To UBound(varSheetAr, 1)
For iCol = LBound(varSheetAr, 2) To UBound(varSheetAr, 2)
If varSheetAr(iRow, iCol) = varSheetBr(iRow, iCol) Then
varSheetA.Cells(iRow, iCol).Interior.ColorIndex = xlNone
varSheetB.Cells(iRow, iCol).Interior.ColorIndex = xlNone
Else
varSheetA.Cells(iRow, iCol).Interior.ColorIndex = 22
varSheetB.Cells(iRow, iCol).Interior.ColorIndex = 22
wbkc.Activate
erow = erow + 1
wbkc.Sheets("Summary").Cells(erow, 1) = ws.Name 'ADDed
wbkc.Sheets("Summary").Cells(erow, 2) = iRow
wbkc.Sheets("Summary").Cells(erow, 3) = iCol
wbkc.Sheets("Summary").Cells(erow, 4) = varSheetA.Cells(iRow, iCol)
wbkc.Sheets("Summary").Cells(erow, 5) = varSheetB.Cells(iRow, iCol)
End If
Next iCol
Next iRow
Next ws

Excel-VBA: Loop to highlight cells

The second half of my code (a loop) needs to highlight cells if they are not equal to another worksheet. I am getting a error on the varSheetB line under the "else" section of the loop. I believe I am using the wrong syntax to tell it to highlight those cells.
This should be an easy fix. Can someone please provide the correct syntax for telling it to highlight the cells under the "else" portion of the loop?
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
' Cells are identical.
' Do nothing
Else
' Cells are different.
' Highlight different cells yellow.
varSheetB.Range.(iRow & iCol).Interior.ColorIndex = 36
End If
Next iCol
Next iRow
End Sub
Edit: Adding the full code.
Option Explicit
Sub Compare()
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
strRangeToCheck = "A12:G150"
Debug.Print Now
varSheetA = Worksheets("Main").Range(strRangeToCheck)
varSheetB = Worksheets("Discrepancy Compare").Range(strRangeToCheck) ' or whatever your other sheet is.
Debug.Print Now
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
' Cells are identical.
' Do nothing.
Else
' Cells are different.
' Highlight different cells yellow.
varSheetB.Range.(iRow & iCol).Interior.ColorIndex = 36
End If
Next iCol
Next iRow
End Sub
Now Tested
Option Explicit
Sub Compare()
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
strRangeToCheck = "A12:G150"
varSheetA = Worksheets("Main").Range(strRangeToCheck)
varSheetB = Worksheets("Discrepancy Compare").Range(strRangeToCheck) ' or whatever your other sheet is.
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) <> varSheetB(iRow, iCol) Then
' Cells are different.
' Highlight different cells yellow.
Worksheets("Discrepancy Compare").Cells(iRow + 11, iCol).Interior.ColorIndex = 36
End If
Next iCol
Next iRow
End Sub
Range is not Range.() it is Range().
But, range will expect a Character string for the column and you are passing a number.
In this instance use Cells() which will allow the use of a number for the column:
varSheetB.Cells(iRow, iCol).Interior.ColorIndex = 36
But you need to ensure the iRow and iCol do not start at 0, depending on your setup and how the arrays were filled you may start at 0.
Also, unless you start loading the array from A1 the column and Rows will be off.

Resources