Using Application.Union

[Bob G.]

I have a compare between 2 worksheets I have been using but it is very ridged. I am looking to make it less so. What the workbook is doing now is inserting a column A to sheets "Update" and "Base" that is equal to "A1"&"B1" and copied to the end of the column. Once the compare is complete the columns are deleted. What I trying to do is remove the need to inserted the columns. I would like to using the Application.Union function, however it works for Application.Union(sh2.Range("A2:A" & LR), sh2.Range("B2:B" & LR)), but, change the second part of the to say "Range("C2:C" & LR)" I get a "TYPE MISMATCH". Can anyone help?

Sub Des_mod_compare_2222222()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, LR As Long, rng As Range, C As Range
Dim i As Long, C1 As Long, C2 As Long, C3 As Long, C4 As Long

Set sh1 = Sheets("Base") 'Edit sheet name
Set sh2 = Sheets("Update") 'Edit Sheet name
Set sh3 = Sheets("Des Changes") 'Edit sheet name
LR = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Application.Union(sh2.Range("A2:A" & LR), sh2.Range("B2:B" & LR))
  For Each C In rng
  If Application.CountIf(Application.Union(sh1.Range("A:A"), sh1.Range("B:B")), C.Value) = 0 Then
  sh2.Range("A" & C.Row).Resize(1, 1).Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)
  End If
  Next
End Sub

 

[Deepak]

Check if this helps as no need to use union here.

Sub Des_mod_compare_2222222_new()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, LR As Long, rng As Range, C As Range
Dim i As Long, C1 As Long, C2 As Long, C3 As Long, C4 As Long

Set sh1 = Sheets("Base") 'Edit sheet name
Set sh2 = Sheets("Update") 'Edit Sheet name
Set sh3 = Sheets("Des Changes") 'Edit sheet name
With sh2
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set rng = .Range("A2:B" & LR)
        For Each C In rng
            If Application.CountIf(sh1.Range("A:B"), C.Value) = 0 Then
                    .Range("A" & C.Row).Resize(1, 1).Copy sh3.Cells(sh3.Rows.Count, 1).End(xlUp)(2)
            End If
        Next
End With
End Sub

 

[Bob G.]

Deepak,

Thank you for your help. My question is how to make the code work for columns A & B, as well as A & C, A & D, and A & E. Column "A" will be a constant, and second column will vary from "B" to "P" with different data types like, B = description and F = start date, to name a few. I think I need a "Union" or "index" to make it work, but I am very new to VBA, some any recordation are appeased.

Thanks again for your help…

 

[shrivallabha]

I think what you want is CONCATENATE. Could you post a sample file with some example results?

 

[Bob G.]

Shrivallabha,

Attached is some sample data....

 

[shrivallabha]

Hi Bob,
Now we have the input information. What do you need as output?

Do you want to list all Activity IDs where any of the item starting from "Activity Name"[Column B] to "Total Float"[Column I] in Base and Update sheet differs?

 

[Bob G.]

What I would like to happen is copy the "Activity Id" for any items that have changed to a new sheet based on the type of change. So "Remaining Duration" changes will go to "Remaining Duration" Tab.

 

[shrivallabha]

Is it possible to have a case where an activity ID may not be present in one sheet while it will be in the other?

Here's code which I have worked out. You need to have a sheet named "Des Changes" so as to list differing cells.

Public Sub FindDiff()
Dim wsBase As Worksheet, wsUpdt As Worksheet, wsChng As Worksheet
Dim r As Range, rFind As Range
Dim lngLastCol As Long, lngLastRow As Long
Dim blDiff As Boolean

'\\ Set up basic info. Change this to suit
Set wsBase = Sheets("Base")
Set wsUpdt = Sheets("Update")
Set wsChng = Sheets("Des Changes") '\\ Create this sheet if not there
lngLastCol = Sheets("Base").Cells(1, Columns.Count).End(xlToLeft).Column
wsChng.Cells.Clear
wsBase.Range(Cells(1, 1), Cells(1, lngLastCol)).Copy wsChng.Range("A1")

'\\ Loop through data in sheet base
For Each r In wsBase.Range("A2:A" & wsBase.Range("A" & Rows.Count).End(xlUp).Row)
  Set rFind = wsUpdt.Range("A:A").Find(r.Value, [A1], xlValues, xlByRows)
  If Not rFind Is Nothing Then
  blDiff = False '\\ Variable for copying the first column data only once
  For i = 2 To lngLastCol '\\ Loop through all columns other than A to check diff
  If wsBase.Cells(r.Row, i).Value <> wsUpdt.Cells(rFind.Row, i).Value Then
  If blDiff Then
  wsUpdt.Cells(rFind.Row, i).Copy wsChng.Cells(lngLastRow, i)
  Else
  lngLastRow = wsChng.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
  r.Copy wsChng.Cells(lngLastRow, "A")
  wsUpdt.Cells(rFind.Row, i).Copy wsChng.Cells(lngLastRow, i)
  blDiff = True
  End If
  End If
  Next i
  Else
  '\\ inform if a value is not found
  MsgBox "Value : " & r.Value & " not found in update sheet!", vbInformation
  End If
Next r

End Sub

I am also attaching the workbook which I used for testing.

 

[Bob G.]

Thanks and yes there will be times when there will be "Activity ID" in one but not the other...

I will try and run it shortly...