Need Help with VBA. **URGENT**

[BuckeyeRJB]

Hey Everyone,

I am having some issues with my VBA code. I have already coded half of it and it's working fine. I need to have the contents of my 1st and 2nd worksheet generate onto the 3rd worksheet. Now here's the catch, I need it to see if there are any differences between the data on sheet1 and sheet2. if there is a difference i need it to be color filled and displayed onto the 3rd sheet with the number difference between the two. For example: Sheet1 in cell 24a has "3" but yet Sheet2 has that same cell as "5". I need that cell in the 3rd sheet to read "+2". If there is no difference, i still need it to show up on the third worksheet but just have the value of the cell be "0". Only numbers will be affected in this scenario. If the data is just general text then it can simply copy paste over to Sheet3. Thanks for the help guys. The code that I have so far will be below.

Sub RunCompare()


Call compareSheets("Sheet1", "Sheet2")


End Sub




Sub compareSheets(shtSheet1 As String, shtSheet2 As String)


Dim mycell As Range
Dim mydiffs As Integer


'For each cell in sheet2 that is not the same in Sheet1, color it yellow
For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
If Not IsDate(mycell) Then
If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then

mycell.Interior.Color = vbRed
mydiffs = mydiffs + 1
Else
mycell.Interior.ColorIndex = 0



End If

Next


For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
If IsDate(mycell) Then
If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then

mycell.Interior.Color = vbYellow
mydiffs = mydiffs + 1
Else
mycell.Interior.ColorIndex = 0

End If
End If
Next


'For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange
' If IsDate(mycell) Then
' If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then
' If mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then
'
' End If
' End If
' End If
'Next




'Display a message box to demonstrate the differences
MsgBox mydiffs & " differences found", vbInformation


ActiveWorkbook.Sheets(shtSheet2).Select


End Sub

 

[JLGWhiz]

Maybe something like this

For Each mycell In Sheets(shtSheet2).UsedRange
 If IsDate(mycell) And mycell.Value <> Sheets(shtSheet1).Cells(mycell.Row, myCell.Column).Value Then
  Sheets(3).Cells(mycell.Row, mycell.Column) = _
  Sheets(shtSheet2).Cells(mycell.Row, mycell.Column).Value - Sheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value
 End If
Next

 

[BuckeyeRJB]

That didn't work. The only thing im getting is a -365 in cell A26 on sheet3. Everything else is blank.

 

[JLGWhiz]

OK, lets try it this way. Assuming that you only want the positive difference between the unmatching values.

Dim c As Range, adr As String, a As Double, b As Double
For Each c In Sheets(shtSheet2).UsedRange
    If c.Interior.Color = vbYellow Then
        adr = c.Address
        a = Sheets(shtSheet1).Range(adr).Value
        b = Sheets(shtSheet2).Range(adr).Value
        If IsNumeric(a) And IsNumeric(b) Then
            If a > b Then
                Sheets(3).Range(adr) = a - b
            Else
                Sheets(3).Range(adr) = b - a
            End If
        End If
    End If
Next

 

[BuckeyeRJB]

It's still not working. This is whats showing up with that code.

[/URL][/IMG]

The second sheet looks like this:

[/URL][/IMG]

So i need the third sheet to look like this once the code has been run:

[/URL][/IMG]

With that said, I need it to be the difference on the numbers. Whether its more or less or positive or negative. The zeros in sheet 3 represent that there wasnt a change in those numbers between sheet 1 and sheet 2. Thats what i need. Thanks for the help.

 

[JLGWhiz]

After looking over your sheet layout and pondering the options, it seems to be a bit more than I want to chew right now. There is no quick and dirty way that I can see to do what you want. I cannot think of anything that would allow some of the cells to be isolated as text in a broad sweep, nor as individual cells, since some of them would also be recognized as numeric. It looks like it would need the specific ranges to be addressed for either copying (for the text values) or matching (for the numeric values). It can be done, but as I said, more than I want to tackle. Sorry, Regards, JLG