Match same values after finding words using a macro in an excel report

Excel Formula | Macro | Script

Match same values after finding words using a macro in an excel report

This macro helps me to copy and paste data from another sheet after matching identical values but not before to find some specific words. First, from the sheet1, it looks for the particular words (for my example, words starting with “INCxxx” in column D) then its categories (for my example, “NT” and “unix” in column E). So if the sheet1 has no “INCxxx”, it will do nothing if not, it will check if there are the words “NT” and/or “unix” and of course, it there are none, nothing will be done.

Once the first step is OK, from the sheet2, it will identify if in column A, B, C and D have the same values. If yes, it will report back to the sheet1 as “NT unix” with its corresponding values. If no, it will do each “NT” and each “unix” separately. And to end, the macro will sort the column A.

sheet1

sheet2

Result in sheet1

When I use the macro ?

When I have to find same values for some specific words in order to have them in one single row.

How to create the macro ?

Read How to create, edit, hide and select a macro in an excel report

How to create the button to associate it with the macro ?

Read How to create a button and associated it to a macro in an excel report

How is/are the macro(s) ?

Copy the code below and paste it into your macro. You will see my comments in green if exist so follow the help to adapt to your need.

Option 1, recommended for 2 words maximum although it can be used with more:


Sub test()
Dim SrchRng As Range
Dim cell As Range
' change D by yours
Set SrchRng = Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
For Each cell In SrchRng
  With cell
    ' change INCxxx by yours
    If .Value Like "INCxxx*" Then
      Dim i As Long
      Dim clearng1 As Long
      Dim clearng2 As Long
      Dim x0 As Range, x1 As Range, x2 As Range, x3 As Range
      clearng1 = .Offset(0, 0).Row
      i = 1
      ' change Sheet2 and E3:E10 by yours
      For Each x1 In Worksheets("Sheet2").Range("E3:E" & Cells(Rows.Count, "E").End(xlUp).Row)
        If x1.Value = .Value Then
          ' change nt and unix by yours
          ' 1 = column E because the search range is from sheet1 column D so change by yours
          If .Offset(0, 1) = "nt unix" Or .Offset(0, 1) = "unix nt" Then
            ' change Sheet2 and A3:A10 by yours
            For Each x2 In Worksheets("Sheet2").Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row)
              ' for .Offset: 1 = column E because the search range is from sheet1 column D so change by yours
              ' for x2.Offset: 1 = column B, 2 = column C, etc. because the search range is from sheet2 column A so change by yours
              If x2.Offset(0, 4) = .Value And x2.Value = x2.Offset(0, 2) And x2.Offset(0, 1) = x2.Offset(0, 3) Then
                ' to include 0, change > 0 by >= 0
                If x2.Offset(0, 0) > 0 Then
                  ' change C by yours
                  x2.Offset(0, 0).Copy Range("C" & Rows.Count).End(xlUp).Offset(i, 0)
                  x2.Offset(0, 1).Copy
                  ' change D by yours
                  Range("D" & Rows.Count).End(xlUp).Offset(i, 0).PasteSpecial xlPasteValues
                  ' change E by yours
                  Range("E" & Rows.Count).End(xlUp).Offset(i, 0) = "NT unix"
                  Range(.Offset(0, -3), .Offset(0, -2)).Copy Range("A" & Rows.Count).End(xlUp).Offset(i, 0)
                  ' change F by yours
                  .Offset(0, 2).Copy Range("F" & Rows.Count).End(xlUp).Offset(i, 0)
                  i = 0 + 1
                End If
              End If
            ' end sheet2
            Next
            For Each x2 In Worksheets("Sheet2").Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row)
              If (x2.Offset(0, 4) = .Value And x2.Value <> x2.Offset(0, 2)) Or (x2.Offset(0, 4) = .Value And x2.Value = x2.Offset(0, 2) And x2.Offset(0, 1) <> x2.Offset(0, 3)) Then
                If x2.Offset(0, 0) > 0 Then
                  x2.Offset(0, 0).Copy Range("C" & Rows.Count).End(xlUp).Offset(i, 0)
                  x2.Offset(0, 1).Copy
                  Range("D" & Rows.Count).End(xlUp).Offset(i, 0).PasteSpecial xlPasteValues
                  Range("E" & Rows.Count).End(xlUp).Offset(i, 0) = "NT"
                  Range(.Offset(0, -3), .Offset(0, -2)).Copy Range("A" & Rows.Count).End(xlUp).Offset(i, 0)
                  .Offset(0, 2).Copy Range("F" & Rows.Count).End(xlUp).Offset(i, 0)
                  i = 0 + 1
                End If
              End If
            Next
            For Each x2 In Worksheets("Sheet2").Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row)
              If (x2.Offset(0, 4) = .Value And x2.Value <> x2.Offset(0, 2)) Or (x2.Offset(0, 4) = .Value And x2.Value = x2.Offset(0, 2) And x2.Offset(0, 1) <> x2.Offset(0, 3)) Then
                If x2.Offset(0, 2) > 0 Then
                  x2.Offset(0, 2).Copy Range("C" & Rows.Count).End(xlUp).Offset(i, 0)
                  x2.Offset(0, 3).Copy
                  Range("D" & Rows.Count).End(xlUp).Offset(i, 0).PasteSpecial xlPasteValues
                  Range("E" & Rows.Count).End(xlUp).Offset(i, 0) = "unix"
                  Range(.Offset(0, -3), .Offset(0, -2)).Copy Range("A" & Rows.Count).End(xlUp).Offset(i, 0)
                  .Offset(0, 2).Copy Range("F" & Rows.Count).End(xlUp).Offset(i, 0)
                  i = 0 + 1
                End If
              End If
            Next
          Else
            If .Offset(0, 1) = "nt" Then
              For Each x2 In Worksheets("Sheet2").Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row)
                If x2.Offset(0, 4) = .Value Then
                  If x2.Value > 0 Then
                    x2.Offset(0, 0).Copy Range("C" & Rows.Count).End(xlUp).Offset(i, 0)
                    x2.Offset(0, 1).Copy
                    Range("D" & Rows.Count).End(xlUp).Offset(i, 0).PasteSpecial xlPasteValues
                    Range("E" & Rows.Count).End(xlUp).Offset(i, 0) = "NT"
                    Range(.Offset(0, -3), .Offset(0, -2)).Copy Range("A" & Rows.Count).End(xlUp).Offset(i, 0)
                    .Offset(0, 2).Copy Range("F" & Rows.Count).End(xlUp).Offset(i, 0)
                    i = 0 + 1
                  End If
                End If
              Next
            Else
              If .Offset(0, 1) = "unix" Then
                ' start sheet2
                ' change Sheet2 and C3:C10 by yours
                For Each x3 In Worksheets("Sheet2").Range("C3:C" & Cells(Rows.Count, "C").End(xlUp).Row)
                  ' 2 = column E because the search range is from sheet2 column C so change by yours
                  If x3.Offset(0, 2) = .Value Then
                    If x3.Value > 0 Then
                      x3.Offset(0, 0).Copy Range("C" & Rows.Count).End(xlUp).Offset(i, 0)
                      x3.Offset(0, 1).Copy
                      Range("D" & Rows.Count).End(xlUp).Offset(i, 0).PasteSpecial xlPasteValues
                      Range("E" & Rows.Count).End(xlUp).Offset(i, 0) = "unix"
                      Range(.Offset(0, -3), .Offset(0, -2)).Copy Range("A" & Rows.Count).End(xlUp).Offset(i, 0)
                      .Offset(0, 2).Copy Range("F" & Rows.Count).End(xlUp).Offset(i, 0)
                      i = 0 + 1
                    End If
                  End If
                ' end sheet2
                Next
              End If
            End If
          End If
        clearng2 = Cells(Rows.Count, "A").End(xlUp).Row
        ' change F by yours
        Range("A" & clearng1 + 1 & ":F" & clearng2).Copy Range("A" & clearng1)
        Range("A" & clearng2 & ":F" & clearng2).ClearContents
        End If
      Next
    End If
  End With
Next cell
' to sort from another column than A (i.e. column D), change Key1:=Range("A2") by Key1:=Range("D2")
' for descending, change xlAscending by xlDescending
Range("A2:F" & Cells(Rows.Count, "F").End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending
End Sub

Option 2, recommended for 3 or more words (although it can be used with less) and the result will look like this:


Sub test()
Dim SrchRng As Range
Dim cell As Range
' change D by yours
Set SrchRng = Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
For Each cell In SrchRng
  With cell
    ' change INCxxx by yours
    If .Value Like "INCxxx*" Then
      Dim i As Long
      Dim clearng1 As Long
      Dim clearng2 As Long
      Dim x1 As Range, x2 As Range
      clearng1 = .Offset(0, 0).Row
      i = 1
      ' change Sheet2 and E3:E10 by yours
      For Each x1 In Worksheets("Sheet2").Range("E3:E" & Cells(Rows.Count, "E").End(xlUp).Row)
        If x1.Value = .Value Then
          ' change nt and unix by yours
          ' 1 = column E because the search range is from sheet1 column D so change by yours
          If .Offset(0, 1) Like "*nt*" Or .Offset(0, 1) Like "*unix*" Then
            ' change Sheet2 and A3:A10 by yours
            For Each x2 In Worksheets("Sheet2").Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row)
              ' for .Offset: 1 = column E because the search range is from sheet1 column D so change by yours
              ' for x2.Offset: 1 = column B, 2 = column C, etc. because the search range is from sheet2 column A so change by yours
              If (.Offset(0, 1) Like "*nt*unix*" Or .Offset(0, 1) Like "*unix*nt*") And x2.Offset(0, 4) = .Value And x2.Value = x2.Offset(0, 2) And x2.Offset(0, 1) = x2.Offset(0, 3) Then
                ' to include 0, change > 0 by >= 0
                If x2.Offset(0, 0) > 0 Then
                  ' change C by yours
                  x2.Offset(0, 0).Copy Range("C" & Rows.Count).End(xlUp).Offset(i, 0)
                  x2.Offset(0, 1).Copy
                  ' change D by yours
                  Range("D" & Rows.Count).End(xlUp).Offset(i, 0).PasteSpecial xlPasteValues
                  ' change E by yours
                  Range("E" & Rows.Count).End(xlUp).Offset(i, 0) = "NT unix"
                  Range(.Offset(0, -3), .Offset(0, -2)).Copy Range("A" & Rows.Count).End(xlUp).Offset(i, 0)
                  ' change F by yours
                  .Offset(0, 2).Copy Range("F" & Rows.Count).End(xlUp).Offset(i, 0)
                  i = 0 + 1
                End If
              Else
                If (.Offset(0, 1) Like "*nt*unix*" Or .Offset(0, 1) Like "*unix*nt*") And x2.Offset(0, 4) = .Value Then
                  If x2.Offset(0, 0) > 0 Then
                    x2.Offset(0, 0).Copy Range("C" & Rows.Count).End(xlUp).Offset(i, 0)
                    x2.Offset(0, 1).Copy
                    Range("D" & Rows.Count).End(xlUp).Offset(i, 0).PasteSpecial xlPasteValues
                    Range("E" & Rows.Count).End(xlUp).Offset(i, 0) = "NT"
                    Range(.Offset(0, -3), .Offset(0, -2)).Copy Range("A" & Rows.Count).End(xlUp).Offset(i, 0)
                    .Offset(0, 2).Copy Range("F" & Rows.Count).End(xlUp).Offset(i, 0)
                    i = 0 + 1
                  End If
                  If x2.Offset(0, 2) > 0 Then
                    x2.Offset(0, 2).Copy Range("C" & Rows.Count).End(xlUp).Offset(i, 0)
                    x2.Offset(0, 3).Copy
                    Range("D" & Rows.Count).End(xlUp).Offset(i, 0).PasteSpecial xlPasteValues
                    Range("E" & Rows.Count).End(xlUp).Offset(i, 0) = "unix"
                    Range(.Offset(0, -3), .Offset(0, -2)).Copy Range("A" & Rows.Count).End(xlUp).Offset(i, 0)
                    .Offset(0, 2).Copy Range("F" & Rows.Count).End(xlUp).Offset(i, 0)
                    i = 0 + 1
                  End If
                Else
                  If .Offset(0, 1) Like "*nt*" And x2.Offset(0, 4) = .Value Then
                    If x2.Offset(0, 0) > 0 Then
                      x2.Offset(0, 0).Copy Range("C" & Rows.Count).End(xlUp).Offset(i, 0)
                      x2.Offset(0, 1).Copy
                      Range("D" & Rows.Count).End(xlUp).Offset(i, 0).PasteSpecial xlPasteValues
                      Range("E" & Rows.Count).End(xlUp).Offset(i, 0) = "NT"
                      Range(.Offset(0, -3), .Offset(0, -2)).Copy Range("A" & Rows.Count).End(xlUp).Offset(i, 0)
                      .Offset(0, 2).Copy Range("F" & Rows.Count).End(xlUp).Offset(i, 0)
                      i = 0 + 1
                    End If
                  Else
                    If .Offset(0, 1) Like "*unix*" And x2.Offset(0, 4) = .Value Then
                      If x2.Offset(0, 2) > 0 Then
                        x2.Offset(0, 2).Copy Range("C" & Rows.Count).End(xlUp).Offset(i, 0)
                        x2.Offset(0, 3).Copy
                        Range("D" & Rows.Count).End(xlUp).Offset(i, 0).PasteSpecial xlPasteValues
                        Range("E" & Rows.Count).End(xlUp).Offset(i, 0) = "unix"
                        Range(.Offset(0, -3), .Offset(0, -2)).Copy Range("A" & Rows.Count).End(xlUp).Offset(i, 0)
                        .Offset(0, 2).Copy Range("F" & Rows.Count).End(xlUp).Offset(i, 0)
                        i = 0 + 1
                      End If
                    End If
                  End If
                End If
              End If
            Next
          End If
        clearng2 = Cells(Rows.Count, "A").End(xlUp).Row
        ' change F by yours
        Range("A" & clearng1 + 1 & ":F" & clearng2).Copy Range("A" & clearng1)
        Range("A" & clearng2 & ":F" & clearng2).ClearContents
        End If
      Next
    End If
  End With
Next cell
' to sort from another column than A (i.e. column D), change Key1:=Range("A2") by Key1:=Range("D2")
' for descending, change xlAscending by xlDescending
Range("A2:F" & Cells(Rows.Count, "F").End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending
End Sub

Interesting Topics

Be successfully certified ITIL 4 Managing Professional

Study, study and study, I couldn’t be successfully certified without studying it, if you are interested...
Be successfully certified ITIL 4 Strategic Leader

With my ITIL 4 Managing Professional certification (ITIL MP) in the pocket, it was time to go for the...
Hide visual and change background color based on selection

Some small tricks to customize the background colour of a text box...
Stacked and clustered column chart or double stacked column chart

In excel, I use a lot the combination of clustered and stacked chart...

Count and check empty cells of filtered columns using a macro in an excel report

I use this macro to check if there are blank cells after I filtered...
Delete rows out of date using a macro in an excel report

In most of the reports, when I am doing the monthly one, I just need to keep all data that are in the month...
Find a specific value then insert a row and more things using a macro in an excel report

This VBA allows me to look for a specific value, it can be...
Execute a macro based on the day or time in an excel report

In some excel files, I am using a macro to tell it in which moment to do the report. For instance, if I am...
List unique values then combine in one single cell all data using a macro in an excel report

In one of my reports, I have to list from a column the unique values...

Copy/paste a range of values after finding the current date in an excel report

This script is to check and compare each cell of a specific column to...
Insert a row after finding a specific value in an excel report

This script allows to search a particular value, once find it, a new row will be inserted above or below...
Copy data between 2 sheets on top or bottom using an office script in an excel report

This online script allows me to copy the full data of a table to another...
Use a script to copy, cut, paste, replace and delete in an excel report (part 2)

This is the second part of my tutorial and it will be focused on...
Autofill from the last row using an office script in an excel report

This script will look for the last row then it will copy and paste the data to a number of rows below...

Calculate a weighted average for a SLA and a conversation time with a formula in an excel report

In one of my experiences, I had a tool that gave me the weighted average...
Search in different sheets then display the wanted data with a formula in an excel report

vlookup and hlookup are formulas that allow to search a data in another...
Find the good data by matching 3 different criterias with a formula in an excel report

It is a combination of “index” and “match” formulas, much better...
Sum and count sales with a formula in an excel report

Extracting data from salesforce or qlikview may not give the information I needed, it already happened...

Know how long a service is impacted with a formula in an excel report

It is important to know how long the service has been impacted by...

ITIL Reporting

ITIL 4

Power BI

Excel Formula | Macro | Script

Match same values after finding words using a macro in an excel report

Interesting Topics

Be successfully certified ITIL 4 Managing Professional

Be successfully certified ITIL 4 Strategic Leader

Hide visual and change background color based on selection

Stacked and clustered column chart or double stacked column chart

Count and check empty cells of filtered columns using a macro in an excel report

Delete rows out of date using a macro in an excel report

Find a specific value then insert a row and more things using a macro in an excel report

Execute a macro based on the day or time in an excel report

List unique values then combine in one single cell all data using a macro in an excel report

Copy/paste a range of values after finding the current date in an excel report

Insert a row after finding a specific value in an excel report

Copy data between 2 sheets on top or bottom using an office script in an excel report

Use a script to copy, cut, paste, replace and delete in an excel report (part 2)

Autofill from the last row using an office script in an excel report

Calculate a weighted average for a SLA and a conversation time with a formula in an excel report

Search in different sheets then display the wanted data with a formula in an excel report

Find the good data by matching 3 different criterias with a formula in an excel report

Sum and count sales with a formula in an excel report

Know how long a service is impacted with a formula in an excel report