VBA Compare 2 columns and Return the difference in anoth column

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
525
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Hi I am trying to compare cells in 2 columns and return the value in the 3rd column on the same Row.

This is what I have so far, which is the Ranges I need to use, and have several criteria
Compare each cell between Rng1 and Rng2 and if return the value in the xRng Column if:

-the cell Value in Rng1 is below number 1 then hide that row

-the same number between Rng1 and Rng2 then returned value in xRng column as "0" and turn xRng cell Blue

-the difference is greater in Rng1 than Rng then return the difference and turn xRng cell Red

-the difference is Smaller in Rng1 than Rng then return the difference and turn xRng cell Green


Can someone help with this please

Code:
Option Explicit
Public Fnd As Range, Rng1 As Range, Rng2 As Range, xRng As Range, xVal1 As Range, xVal2 As Range, xVal3 As Range

Sub Total()
     If Range("A1").End(xlToRight) = "Total" Then Exit Sub
     Range("A1").End(xlToRight).Offset(, 1) = "Total"
     Set Rng1 = RngReq
     Set Rng2 = RngIss
     Set xRng = RngTotal
     For Each xVal1 in Rng1
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Compare Columns and Return value
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     Next xVal1
End Sub

Function RngReq() As Range
    Set Fnd = ActiveSheet.Columns.Find(What:="RequiredQty", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not Fnd Is Nothing Then
            Set RngReq = Range(Fnd.Offset(1), Cells(Rows.count, Fnd.Column).End(xlUp))
        End If
End Function
Function RngIss() As Range
    Set Fnd = ActiveSheet.Columns.Find(What:="IssuedQty", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not Fnd Is Nothing Then
            Set RngIss = Range(Fnd.Offset(1), Cells(Rows.count, Fnd.Column).End(xlUp))
        End If
End Function
Function RngTotal() As Range
    Set Fnd = ActiveSheet.Columns.Find(What:="Total", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not Fnd Is Nothing Then
            Set RngTotal = Range(Fnd.Offset(1), Cells(Rows.count, Fnd.Column).End(xlUp))
        End If
End Function


Example

Rng1 ColumnRng2 ColumnSome ColumnOther ColumnxRng Column
60300
1000
0.0010
2020

<tbody>
</tbody>

To

Rng1 Column
Rng2 Column
Some Column
Other Column
xRng Column
60
300
240 (Green)
100
0
100 (Red)
20
20
0 (Blue)

<tbody>
</tbody>
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
525
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Sorted this now, colors changed from previous post. Code below in case others have the same problem

Code:
Option Explicit
Option Compare Text
Public Fnd As Range, Rng1 As Range, Rng2 As Range, xRng As Range, xVal1 As Range
Sub Total()
     If Range("A1").End(xlToRight) = "Total" Then
          MsgBox "Total Already Exists!"
          Exit Sub
     Else
Call Opt_Start
          Range("A1").End(xlToRight).Offset(, 1) = "Total"
          Set Rng1 = RngReq
          Set Rng2 = RngIss
          Set xRng = RngTotal
          For Each xVal1 In Rng1
               If xVal1.Value < 1 Then
                    xVal1.EntireRow.Hidden = True
               ElseIf xVal1.Value > Cells(xVal1.row, Rng2.Column).Value Then
                    Cells(xVal1.row, xRng.Column).Value = Cells(xVal1.row, Rng2.Column).Value - xVal1.Value
                    Cells(xVal1.row, xRng.Column).Interior.ColorIndex = 3
               ElseIf xVal1.Value < Cells(xVal1.row, Rng2.Column).Value Then
                    Cells(xVal1.row, xRng.Column).Value = Cells(xVal1.row, Rng2.Column).Value - xVal1.Value
                    Cells(xVal1.row, xRng.Column).Interior.ColorIndex = 33
               ElseIf xVal1.Value = Cells(xVal1.row, Rng2.Column).Value Then
                    Cells(xVal1.row, xRng.Column).Value = 0
                    Cells(xVal1.row, xRng.Column).Interior.ColorIndex = 36
               End If
          Next xVal1
     End If
Call Opt_End
End Sub
Function RngReq() As Range
    Set Fnd = ActiveSheet.Columns.Find(What:="RequiredQty", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not Fnd Is Nothing Then
            Set RngReq = Range(Fnd.Offset(1), Cells(Rows.count, Fnd.Column).End(xlUp))
        End If
End Function
Function RngIss() As Range
    Set Fnd = ActiveSheet.Columns.Find(What:="IssuedQty", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not Fnd Is Nothing Then
            Set RngIss = Range(Fnd.Offset(1), Cells(Rows.count, Fnd.Column).End(xlUp))
        End If
End Function
Function RngTotal() As Range
    Set Fnd = ActiveSheet.Columns.Find(What:="Total", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not Fnd Is Nothing Then
            Set RngTotal = Range(Fnd.Offset(1), Cells(Rows.count, Fnd.Column).End(xlUp))
        End If
End Function
Public Sub Opt_Start()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
End Sub
Public Sub Opt_End()
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,600
Messages
5,838,291
Members
430,537
Latest member
Antonio11

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top