Find a specific value of the last cell then copy cells from another sheet using a macro in an excel report

This code will find a particular word within or not in a sentence of the last cell of a column then from another sheet, it will copy some cells and paste them to the empty cells.

macro excel macro excel

 

When I use the macro ?

To fill empty cells with the data from another sheet that match a specific value within or not in a sentence.

 

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.


Sub test()
Dim j As Long
Dim lCol As Long, lRow As Long
Dim x1 As Range, x2 As Range
' to find value last cell of a column, change 6 by your ID column, i.e. column F = 6
lCol = Cells(Rows.Count, 6).Column
lRow = Cells(Rows.Count, 6).End(xlUp).Row
MyVal1 = Range(Cells(lRow, 6), Cells(lRow, lCol)) 
MyVal2 = Range(Cells(lRow, 6), Cells(lRow, lCol)) 
' change 0 by 1 if first to paste next row and not same row
j = 0
' change google by your value to find
' to search into a sentence, change "=" by "Like" and put * between the word
If MyVal1 = "google" Or MyVal1 = "Google" Then
  ' change sheet1 by your sheet to copy and H3:H5 by your range
  For Each x1 In Worksheets("Sheet1").Range("H3:H5")
    ' copy only value higher than 1
    ' copy everything, change x1.Value > 1 by Not x1.Value = ""
    If x1.Value > 1 Then
      ' change E by your column to paste
      ' optional change ActiveSheet by Worksheets("Sheet2")
      x1.Offset(0, 0).Copy ActiveSheet.Range("E" & Rows.Count).End(xlUp).Offset(1, 0)
      ' copy value of the left cell i.e. column I
      ' if copy value of the right cell i.e. column G, change (0, 1) by (0, -1)
      x1.Offset(0, 1).Copy
      ' change D by your column to paste
      ActiveSheet.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
      ' change 1 if not column A and 3 if not column C to copy from until
      ' change A if not column A to paste from
      ActiveSheet.Range(Cells(Rows.Count, 1).End(xlUp).Offset(0, 0), Cells(Rows.Count, 3).End(xlUp).Offset(0, 0)).Copy ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(j, 0) 
      ' change 6 if not column F to copy from until
      ' change F if not column F to paste from
      ActiveSheet.Range(Cells(Rows.Count, 6).End(xlUp).Offset(0, 0), Cells(Rows.Count, 6).End(xlUp).Offset(0, 0)).Copy ActiveSheet.Range("F" & Rows.Count).End(xlUp).Offset(j, 0) 
      j = 0 + 1
    End If
  Next
Else
  ' change explorer by your value to find
  If MyVal2 = "explorer" Or MyVal2 = "Explorer" Then
    ' change sheet1 by your sheet to copy and J3:J5 by your range
    For Each x2 In Worksheets("Sheet1").Range("J3:J5")
      If x2.Value > 1 Then
        x2.Offset(0, 0).Copy ActiveSheet.Range("E" & Rows.Count).End(xlUp).Offset(1, 0)
        x2.Offset(0, 1).Copy
        ActiveSheet.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        ActiveSheet.Range(Cells(Rows.Count, 1).End(xlUp).Offset(0, 0), Cells(Rows.Count, 3).End(xlUp).Offset(0, 0)).Copy ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(j, 0) 
        ActiveSheet.Range(Cells(Rows.Count, 6).End(xlUp).Offset(0, 0), Cells(Rows.Count, 6).End(xlUp).Offset(0, 0)).Copy ActiveSheet.Range("F" & Rows.Count).End(xlUp).Offset(j, 0) 
        j = 0 + 1
      End If
    Next
  End If
End If
End Sub              
              

To use this code, I have 2 sheets, “sheet1” and “sheet2”. What I want, it is to fill the empty cells of the “sheet2” based on the value of the last cell of the “type” column, in this example, it is “google”.

macro excel

On the “sheet1”, I have those data:

macro excel

About how to extract the “unique value list”, read this article “List unique values then combine in one single cell all data using a macro in an excel report”. For your report, you may want to combine those 2 codes into 1 single one.

Interesting Topics