Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Comparing values or text in 2 different workbooks
Hello -
I am fairly new to VBA and I have a question to ask. I need to write a code that compares market value, market price, shares, and portfolio numbers. So if for example market price in wb1 is different than wb2 then it should write in a new sheet portfolio number, market value, market price, and shares. It must do the following: 1. compare values in 4 columns in workbook1 to 4 columns in workbook2. 2. if values of any of them are different then it should write in a new sheet the information in the following format: Row 1: wb1 - portfolio number - market price - market value - shares Row 2: wb2 - portfolio number - market price - market value - shares Row 3: Blank Repeat 3. if portfolio number is blank then it should skip this entire field. I really would appreciate all the help! Thanks! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Comparing values or text in 2 different workbooks
There are so many ways to do this! Look he
http://www.softinterface.com/MD%5CDo...n-Software.htm For VBA code, try this: #1) Sub TestCompareWorksheets() CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2") End Sub Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet) Dim r As Long, c As Integer Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String Dim rptWB As Workbook, DiffCount As Long Application.ScreenUpdating = False Application.StatusBar = "Creating the report..." Set rptWB = Workbooks.Add Application.DisplayAlerts = False While Worksheets.Count 1 Worksheets(2).Delete Wend Application.DisplayAlerts = True With ws1.UsedRange lr1 = .Rows.Count lc1 = .Columns.Count End With With ws2.UsedRange lr2 = .Rows.Count lc2 = .Columns.Count End With maxR = lr1 maxC = lc1 If maxR < lr2 Then maxR = lr2 If maxC < lc2 Then maxC = lc2 DiffCount = 0 For c = 1 To maxC Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..." For r = 1 To maxR cf1 = "" cf2 = "" On Error Resume Next cf1 = ws1.Cells(r, c).FormulaLocal cf2 = ws2.Cells(r, c).FormulaLocal On Error GoTo 0 If cf1 < cf2 Then DiffCount = DiffCount + 1 Cells(r, c).Formula = "'" & cf1 & " < " & cf2 End If Next r Next c Application.StatusBar = "Formatting the report..." With Range(Cells(1, 1), Cells(maxR, maxC)) ..Interior.ColorIndex = 19 With .Borders(xlEdgeTop) ..LineStyle = xlContinuous ..Weight = xlHairline End With With .Borders(xlEdgeRight) ..LineStyle = xlContinuous ..Weight = xlHairline End With With .Borders(xlEdgeLeft) ..LineStyle = xlContinuous ..Weight = xlHairline End With With .Borders(xlEdgeBottom) ..LineStyle = xlContinuous ..Weight = xlHairline End With On Error Resume Next With .Borders(xlInsideHorizontal) ..LineStyle = xlContinuous ..Weight = xlHairline End With With .Borders(xlInsideVertical) ..LineStyle = xlContinuous ..Weight = xlHairline End With On Error GoTo 0 End With Columns("A:IV").ColumnWidth = 20 rptWB.Saved = True If DiffCount = 0 Then rptWB.Close False End If Set rptWB = Nothing Application.StatusBar = False Application.ScreenUpdating = True MsgBox DiffCount & " cells contain different formulas!", vbInformation, _ "Compare " & ws1.Name & " with " & ws2.Name End Sub #2) Sub checkrev() With Sheets("Sheet1") Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row Set Sh1Range = .Range("A1:A" & Sh1LastRow) End With With Sheets("Sheet2") Sh2LastRow = .Cells(Rows.Count, "A").End(xlUp).Row Set Sh2Range = .Range("A1:A" & Sh2LastRow) End With 'compare sheet 1 with sheet 2 For Each Sh1cell In Sh1Range Set c = Sh2Range.Find( _ what:=Sh1cell, LookIn:=xlValues) If c Is Nothing Then Sh1cell.Interior.ColorIndex = 3 Sh1cell.Offset(0, 1).Interior.ColorIndex = 3 Else If Sh1cell.Offset(0, 1) < c.Offset(0, 1) Then Sh1cell.Interior.ColorIndex = 6 Sh1cell.Offset(0, 1).Interior.ColorIndex = 6 End If End If Next Sh1cell 'compare sheet 2 with sheet 1 For Each Sh2cell In Sh2Range Set c = Sh1Range.Find( _ what:=Sh2cell, LookIn:=xlValues) If c Is Nothing Then Sh2cell.Interior.ColorIndex = 3 Sh2cell.Offset(0, 1).Interior.ColorIndex = 3 Else If Sh2cell.Offset(0, 1) < c.Offset(0, 1) Then Sh2cell.Interior.ColorIndex = 6 Sh2cell.Offset(0, 1).Interior.ColorIndex = 6 End If End If Next Sh2cell End Sub If those don't work for you, and I am pretty sure they will, post back. I have 4 other possible solutions. HTH, Ryan--- -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "Mo" wrote: Hello - I am fairly new to VBA and I have a question to ask. I need to write a code that compares market value, market price, shares, and portfolio numbers. So if for example market price in wb1 is different than wb2 then it should write in a new sheet portfolio number, market value, market price, and shares. It must do the following: 1. compare values in 4 columns in workbook1 to 4 columns in workbook2. 2. if values of any of them are different then it should write in a new sheet the information in the following format: Row 1: wb1 - portfolio number - market price - market value - shares Row 2: wb2 - portfolio number - market price - market value - shares Row 3: Blank Repeat 3. if portfolio number is blank then it should skip this entire field. I really would appreciate all the help! Thanks! |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Comparing values or text in 2 different workbooks
Wow! those were very good codes bud!! I will definitely be using them in
the future thanks!... Unfortunately however I may not have explained what I need carefully. The codes are comparing cells A1 to A1, B1 to B1, etc. between Sheet 1 and 2. What I need is a little more complicated... Sheet 1 and 2 will have data that is not sorted at all. But Sheet 1 is going to have the ORIGINAL data (the absolutely correct one). Sheet 2 will need to be compared to sheet 1 and spit out any differences. So I need the code to direct the comparison this way: 1. Data in Columns A will always be unique. 2. So choose Sheet1.A1 and look into Sheet2.A:A to find the corresponding and equal value (could be in a completely different cell but will always be in the same column). 3. If there is no match - type the CELL VALUE and "No Match Found" in the report. 4. If there is a match - then I need it to compare the cells in THAT row. For example, if Sheet1.A1 = 123 and that value is located in Sheet2.A9, then compare the values in that entire row 9 to the ones in row 1 and spit out any differences. I really liked your way of highlighting the differences by actually writing the mismatched values so that is something I want to incorporate here for sure. Thanks in advance! Mo "ryguy7272" wrote: There are so many ways to do this! Look he http://www.softinterface.com/MD%5CDo...n-Software.htm For VBA code, try this: #1) Sub TestCompareWorksheets() CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2") End Sub Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet) Dim r As Long, c As Integer Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String Dim rptWB As Workbook, DiffCount As Long Application.ScreenUpdating = False Application.StatusBar = "Creating the report..." Set rptWB = Workbooks.Add Application.DisplayAlerts = False While Worksheets.Count 1 Worksheets(2).Delete Wend Application.DisplayAlerts = True With ws1.UsedRange lr1 = .Rows.Count lc1 = .Columns.Count End With With ws2.UsedRange lr2 = .Rows.Count lc2 = .Columns.Count End With maxR = lr1 maxC = lc1 If maxR < lr2 Then maxR = lr2 If maxC < lc2 Then maxC = lc2 DiffCount = 0 For c = 1 To maxC Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..." For r = 1 To maxR cf1 = "" cf2 = "" On Error Resume Next cf1 = ws1.Cells(r, c).FormulaLocal cf2 = ws2.Cells(r, c).FormulaLocal On Error GoTo 0 If cf1 < cf2 Then DiffCount = DiffCount + 1 Cells(r, c).Formula = "'" & cf1 & " < " & cf2 End If Next r Next c Application.StatusBar = "Formatting the report..." With Range(Cells(1, 1), Cells(maxR, maxC)) .Interior.ColorIndex = 19 With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlHairline End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlHairline End With With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline End With On Error Resume Next With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlHairline End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlHairline End With On Error GoTo 0 End With Columns("A:IV").ColumnWidth = 20 rptWB.Saved = True If DiffCount = 0 Then rptWB.Close False End If Set rptWB = Nothing Application.StatusBar = False Application.ScreenUpdating = True MsgBox DiffCount & " cells contain different formulas!", vbInformation, _ "Compare " & ws1.Name & " with " & ws2.Name End Sub #2) Sub checkrev() With Sheets("Sheet1") Sh1LastRow = .Cells(Rows.Count, "A").End(xlUp).Row Set Sh1Range = .Range("A1:A" & Sh1LastRow) End With With Sheets("Sheet2") Sh2LastRow = .Cells(Rows.Count, "A").End(xlUp).Row Set Sh2Range = .Range("A1:A" & Sh2LastRow) End With 'compare sheet 1 with sheet 2 For Each Sh1cell In Sh1Range Set c = Sh2Range.Find( _ what:=Sh1cell, LookIn:=xlValues) If c Is Nothing Then Sh1cell.Interior.ColorIndex = 3 Sh1cell.Offset(0, 1).Interior.ColorIndex = 3 Else If Sh1cell.Offset(0, 1) < c.Offset(0, 1) Then Sh1cell.Interior.ColorIndex = 6 Sh1cell.Offset(0, 1).Interior.ColorIndex = 6 End If End If Next Sh1cell 'compare sheet 2 with sheet 1 For Each Sh2cell In Sh2Range Set c = Sh1Range.Find( _ what:=Sh2cell, LookIn:=xlValues) If c Is Nothing Then Sh2cell.Interior.ColorIndex = 3 Sh2cell.Offset(0, 1).Interior.ColorIndex = 3 Else If Sh2cell.Offset(0, 1) < c.Offset(0, 1) Then Sh2cell.Interior.ColorIndex = 6 Sh2cell.Offset(0, 1).Interior.ColorIndex = 6 End If End If Next Sh2cell End Sub If those don't work for you, and I am pretty sure they will, post back. I have 4 other possible solutions. HTH, Ryan--- -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "Mo" wrote: Hello - I am fairly new to VBA and I have a question to ask. I need to write a code that compares market value, market price, shares, and portfolio numbers. So if for example market price in wb1 is different than wb2 then it should write in a new sheet portfolio number, market value, market price, and shares. It must do the following: 1. compare values in 4 columns in workbook1 to 4 columns in workbook2. 2. if values of any of them are different then it should write in a new sheet the information in the following format: Row 1: wb1 - portfolio number - market price - market value - shares Row 2: wb2 - portfolio number - market price - market value - shares Row 3: Blank Repeat 3. if portfolio number is blank then it should skip this entire field. I really would appreciate all the help! Thanks! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Comparing two columns of text values | Excel Discussion (Misc queries) | |||
comparing text values in two columns | Excel Discussion (Misc queries) | |||
Formula for comparing text in two workbooks | Excel Worksheet Functions | |||
Looping and Comparing values in two workbooks | Excel Programming | |||
Comparing text instead of values? | Excel Programming |