Option Explicit
Sub Matching_Values()
'*************************************************************************************************************
'* Are values in the CUST_1 Column contained in the CUST_2 and CUST_3 columns. Highlight columns and insert
'* values in the Results column confirming whether there are matches (FAIL) or not (PASS)
'* - Cells will be highlighted as Yellow when values are contained in the CUST_2 column/Row and also in the
'* CUST_1 column
'* - Cells will be highlighted as Orange when values are contained in the CUST_3 column/Row and also in the
'* CUST_1 column.
'* - Cells will be highlighted as Red when values are contained in CUST_1, CUST_2 and CUST_3 columns/Row
'*************************************************************************************************************
Dim LastRow As Long, Result_Column As Long
Dim Cond_Form As Range
'*************************************************************************************************************
'* STEP 1 - Confirm location of the Results column in Row 1 and the last occupied row.
'* - Delete the columns after the Results column
'*************************************************************************************************************
Range("A1").Select
LastRow = 100
Result_Column = 0
With Sheets("Sheet1")
With .Rows(1)
On Error Resume Next
Result_Column = .Find("Result", .Cells(.Cells.Count), xlValues, , xlByColumns, xlPrevious).Column
On Error GoTo 0
End With
End With
If Result_Column > 0 Then
Columns(Result_Column + 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Else
MsgBox "There is no Column called 'Result' in Row 1 - macro stopped"
GoTo Error_End:
End If
'* THE LAST ROW OF THE USED RANGE
Range("A1").Select
ActiveSheet.UsedRange
LastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
If LastRow <= 1 Then
MsgBox "There is no data in the columns - macro stopped"
GoTo Error_End:
End If
'*************************************************************************************************************
'* STEP 2 - Remove the Conditional Formatting from the CUST_1, CUST_2 and CUST_3 Columns
'*************************************************************************************************************
Range(Cells(2, 1), Cells(LastRow, 3)).Select
Selection.FormatConditions.Delete
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'*************************************************************************************************************
'* STEP 3 - Inserting the headings and formula for calculating whether there are matching values
'*************************************************************************************************************
Cells(1, Result_Column + 1).Value = "No of values in CUST_2 Column"
Cells(1, Result_Column + 2).Value = "Is first value in Cust_2 column in the Cust_1 Column"
Cells(1, Result_Column + 3).Value = "Is Second value in Cust_2 column in the Cust_1 Column"
Cells(1, Result_Column + 4).Value = "Is Third value in Cust_2 column in the Cust_1 Column"
Cells(1, Result_Column + 5).Value = "Is Fourth value in Cust_2 column in the Cust_1 Column"
Cells(1, Result_Column + 6).Value = "Is Fifth value in Cust_2 column in the Cust_1 Column"
Cells(1, Result_Column + 7).Value = "Count of Cust_2 column matches"
Cells(1, Result_Column + 8).Value = "No of values in CUST_3 Column"
Cells(1, Result_Column + 9).Value = "Is first value in Cust_3 column in the Cust_1 Column"
Cells(1, Result_Column + 10).Value = "Is Second value in Cust_3 column in the Cust_1 Column"
Cells(1, Result_Column + 11).Value = "Is Third value in Cust_3 column in the Cust_1 Column"
Cells(1, Result_Column + 12).Value = "Is Fourth value in Cust_3 column in the Cust_1 Column"
Cells(1, Result_Column + 13).Value = "Is Fifth value in Cust_3 column in the Cust_1 Column"
Cells(1, Result_Column + 14).Value = "Count of Cust_3 column matches"
Cells(2, Result_Column + 1).FormulaR1C1 = "=LEN(RC[-3])-LEN(SUBSTITUTE(RC[-3],"","",""""))+1"
Cells(2, Result_Column + 2).FormulaR1C1 = "=IFERROR(IF(FIND(IFERROR(LEFT(RC[-4],(FIND("","",RC[-4],1)-1)),RC[-4]),RC1)>0,""MATCH"",""OK""),""OK"")"
Cells(2, Result_Column + 3).FormulaR1C1 = "=IF(RC[-2]>=2,(IFERROR(IF(FIND(TRIM(MID(SUBSTITUTE(RC[-5],"","",REPT("" "",100)),100,100)),RC[-6])>0,""MATCH"",""OK""),""OK"")),"""")"
Cells(2, Result_Column + 4).FormulaR1C1 = "=IF(RC[-3]>=3,(IFERROR(IF(FIND(TRIM(MID(SUBSTITUTE(RC[-6],"","",REPT("" "",100)),200,100)),RC[-7])>0,""MATCH"",""OK""),""OK"")),"""")"
Cells(2, Result_Column + 5).FormulaR1C1 = "=IF(RC[-4]>=4,(IFERROR(IF(FIND(TRIM(MID(SUBSTITUTE(RC[-7],"","",REPT("" "",100)),300,100)),RC[-8])>0,""MATCH"",""OK""),""OK"")),"""")"
Cells(2, Result_Column + 6).FormulaR1C1 = "=IF(RC[-5]>=5,(IFERROR(IF(FIND(TRIM(MID(SUBSTITUTE(RC[-8],"","",REPT("" "",100)),400,100)),RC[-9])>0,""MATCH"",""OK""),""OK"")),"""")"
Cells(2, Result_Column + 7).FormulaR1C1 = "=COUNTIF(RC[-5]:RC[-1],""MATCH"")"
Cells(2, Result_Column + 8).FormulaR1C1 = "=LEN(RC[-9])-LEN(SUBSTITUTE(RC[-9],"","",""""))+1"
Cells(2, Result_Column + 9).FormulaR1C1 = "=IFERROR(IF(FIND(IFERROR(LEFT(RC[-10],(FIND("","",RC[-10],1)-1)),RC[-10]),RC1)>0,""MATCH"",""OK""),""OK"")"
Cells(2, Result_Column + 10).FormulaR1C1 = "=IF(RC[-2]>=2,(IFERROR(IF(FIND(TRIM(MID(SUBSTITUTE(RC[-11],"","",REPT("" "",100)),100,100)),RC[-13])>0,""MATCH"",""OK""),""OK"")),"""")"
Cells(2, Result_Column + 11).FormulaR1C1 = "=IF(RC[-3]>=3,(IFERROR(IF(FIND(TRIM(MID(SUBSTITUTE(RC[-12],"","",REPT("" "",100)),200,100)),RC[-14])>0,""MATCH"",""OK""),""OK"")),"""")"
Cells(2, Result_Column + 12).FormulaR1C1 = "=IF(RC[-4]>=4,(IFERROR(IF(FIND(TRIM(MID(SUBSTITUTE(RC[-13],"","",REPT("" "",100)),300,100)),RC[-15])>0,""MATCH"",""OK""),""OK"")),"""")"
Cells(2, Result_Column + 13).FormulaR1C1 = "=IF(RC[-5]>=5,(IFERROR(IF(FIND(TRIM(MID(SUBSTITUTE(RC[-14],"","",REPT("" "",100)),400,100)),RC[-16])>0,""MATCH"",""OK""),""OK"")),"""")"
Cells(2, Result_Column + 14).FormulaR1C1 = "=COUNTIF(RC[-5]:RC[-1],""MATCH"")"
Range(Cells(1, Result_Column + 1), Cells(1, Result_Column + 14)).Font.Bold = True
Cells.Select
Cells.EntireColumn.AutoFit
Range(Cells(2, Result_Column + 1), Cells(2, Result_Column + 14)).Select
Selection.AutoFill Destination:=Range(Cells(2, Result_Column + 1), Cells(LastRow, Result_Column + 14)), Type:=xlFillDefault
Range("A1").Select
'*************************************************************************************************************
'* STEP 4 - Inserting the Formula into the Results column. Copying down the rows and then removing formula
'* and making them values
'*************************************************************************************************************
Cells(2, Result_Column).FormulaR1C1 = "=IF(OR(RC[7]>0,RC[14]>0),""FAIL"",""PASS"")"
Range(Cells(2, Result_Column), Cells(2, Result_Column)).Select
Selection.AutoFill Destination:=Range(Cells(2, Result_Column), Cells(LastRow, Result_Column)), Type:=xlFillDefault
Range(Cells(2, Result_Column), Cells(LastRow, Result_Column)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
'*************************************************************************************************************
'* STEP 5a - Applying the Conditional formatting from Range A2:C2 to the no of rows in the range - A2
'*************************************************************************************************************
Range("A2").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(K2>0,R2=0)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(K2=0,R2>0)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(K2>0,R2>0)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
'*************************************************************************************************************
'* STEP 5b - Applying the Conditional formatting from Range B2:D2 to the no of rows in the range - B2
'*************************************************************************************************************
Range("B2").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=K2>0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
'*************************************************************************************************************
'* STEP 5c - Applying the Conditional formatting from Range B2:D2 to the no of rows in the range - C2
'*************************************************************************************************************
Range("C2").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=R2>0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
'*************************************************************************************************************
'* STEP 5d - Copying the conditional formatting down the range.
'*************************************************************************************************************
Range(Cells(2, 1), Cells(2, 3)).Select
Selection.Copy
Range(Cells(2, 1), Cells(LastRow, 3)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'*************************************************************************************************************
'* STEP 5e - Remove the conditional formatting but retain the colours
'*************************************************************************************************************
For Each Cond_Form In Selection
Cond_Form.Interior.Color = Cond_Form.DisplayFormat.Interior.Color
Next
Selection.FormatConditions.Delete
Result_Column = Result_Column
'*************************************************************************************************************
'* STEP 6 - Confirm location of the Results column in Row 1 and the last occupied row.
'* - Delete the columns after the Results + 1 column
'*************************************************************************************************************
Range("A1").Select
LastRow = 100
Result_Column = 0
With Sheets("Sheet1")
With .Rows(1)
On Error Resume Next
Result_Column = .Find("Result", .Cells(.Cells.Count), xlValues, , xlByColumns, xlPrevious).Column
On Error GoTo 0
End With
End With
If Result_Column > 0 Then
Columns(Result_Column + 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End If
Error_End:
End Sub