VBA - Copy row based on text in cell to a new sheet into first empty row

randomintel

New Member
Joined
Apr 23, 2019
Messages
7
Dear all,

I've been looking high and low for a macro that will help me copy a certain row based a specific string in a cell to a new sheet and the first empty row in that sheet. Please help me figure this out.

Context:
- One Excel file
- Two sheets "JiraData" and "Dash". Please note that "JiraData" is updated daily through a query and can thus be seen as master data.
- I have a macro that copies all the filled rows from "JiraData" to "Dash". Used before each new sprint to plan capacity.
- I have a macro that compares rows between "JiraData" and "Dash" using a formula, and adds string "Missing" behind those rows that aren't present in the "Dash". This is used to visually spot new rows that appear in "JiraData", but weren't previously copied over to "Dash".

Challenge:
I am trying to create a macro that will scan column I in sheet "JiraData" for the string "Missing". Then copy that whole respective row (A:H) from "JiraData" to the first empty row in "Dash" starting from B3 down. I would also like to add a date stamp in column A that shows when the new row was added to "Dash".

Goal:
Be able to add new rows to "Dash" when "JiraData" has new rows that aren't already entered in "Dash".


Thank you so much beforehand, I really appreciate your time reading this.
 

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

mrshl9898

Well-known Member
Joined
Feb 6, 2012
Messages
1,297
Sounds like:

VBA Code:
Sub copy()

Dim sht As Worksheet
Dim sht2 As Worksheet
Dim LastRow As Long
Dim LastRow2 As Long

Set sht = Sheets("Dash")
Set sht2 = Sheets("JiraData")

LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
LastRow2 = sht2.Cells(sht2.Rows.Count, "A").End(xlUp).Row

With sht2
    .AutoFilterMode = False
    With .Range("A1:I" & LastRow2)
        .AutoFilter Field:=9, Criteria1:="Missing"
        .SpecialCells(xlCellTypeVisible).copy Destination:=sht.Range("A" & LastRow)
    End With
End With


End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,181
Office Version
2007
Platform
Windows
Here another macro for you to consider:

VBA Code:
Sub Copy_Missing_Rows()
  With Sheets("JiraData")
    If .AutoFilterMode Then .AutoFilterMode = False
    .Range("A1:I" & .Range("I" & Rows.Count).End(xlUp).Row).AutoFilter 9, "Missing"
    .AutoFilter.Range.Range("A2:H" & .Range("I" & Rows.Count).End(xlUp).Row).Offset(1).Copy
    With Sheets("Dash")
      .Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial xlValues
      .Range("A" & .Range("A" & Rows.Count).End(xlUp)(2).Row & ":A" & .Range("B" & Rows.Count).End(xlUp).Row).Value = Date
    End With
    .ShowAllData
  End With
  Application.CutCopyMode = False
End Sub
 

randomintel

New Member
Joined
Apr 23, 2019
Messages
7
Here another macro for you to consider:

VBA Code:
Sub Copy_Missing_Rows()
  With Sheets("JiraData")
    If .AutoFilterMode Then .AutoFilterMode = False
    .Range("A1:I" & .Range("I" & Rows.Count).End(xlUp).Row).AutoFilter 9, "Missing"
    .AutoFilter.Range.Range("A2:H" & .Range("I" & Rows.Count).End(xlUp).Row).Offset(1).Copy
    With Sheets("Dash")
      .Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial xlValues
      .Range("A" & .Range("A" & Rows.Count).End(xlUp)(2).Row & ":A" & .Range("B" & Rows.Count).End(xlUp).Row).Value = Date
    End With
    .ShowAllData
  End With
  Application.CutCopyMode = False
End Sub
Thank you Dante Amor, that worked really well!:biggrin:

I am however struggling with the .ShowAllData command. It returns an error since the sheet I am in when I run the macro is "Dash". I've tried rewriting it, but can't seem to figure why it doesn't work:

VBA Code:
  If (Sheets("JiraData").AutoFilterMode And Sheets("JiraData").FilterMode) Or Sheets("JiraData").FilterMode Then
    Sheets("JiraData").ShowAllData
Thoughts?
 

randomintel

New Member
Joined
Apr 23, 2019
Messages
7
Sounds like:

VBA Code:
Sub copy()

Dim sht As Worksheet
Dim sht2 As Worksheet
Dim LastRow As Long
Dim LastRow2 As Long

Set sht = Sheets("Dash")
Set sht2 = Sheets("JiraData")

LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
LastRow2 = sht2.Cells(sht2.Rows.Count, "A").End(xlUp).Row

With sht2
    .AutoFilterMode = False
    With .Range("A1:I" & LastRow2)
        .AutoFilter Field:=9, Criteria1:="Missing"
        .SpecialCells(xlCellTypeVisible).copy Destination:=sht.Range("A" & LastRow)
    End With
End With


End Sub
Thank you for the effort, this almost did the trick but DanteAmor nailed it ;)
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,181
Office Version
2007
Platform
Windows
It doesn't matter on which sheet you perform the execution.
Try this:

VBA Code:
Sub Copy_Missing_Rows()
  With Sheets("JiraData")
    If .AutoFilterMode Then .AutoFilterMode = False
    If .FilterMode Then .ShowAllData
    .Range("A1:I" & .Range("I" & Rows.Count).End(xlUp).Row).AutoFilter 9, "Missing"
    .AutoFilter.Range.Range("A2:H" & .Range("I" & Rows.Count).End(xlUp).Row).Offset(1).Copy
    With Sheets("Dash")
      If .AutoFilterMode Then .AutoFilterMode = False
      If .FilterMode Then .ShowAllData
      .Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial xlValues
      .Range("A" & .Range("A" & Rows.Count).End(xlUp)(2).Row & ":A" & .Range("B" & Rows.Count).End(xlUp).Row).Value = Date
    End With
    If .AutoFilterMode Then .AutoFilterMode = False
  End With
  Application.CutCopyMode = False
End Sub
 

randomintel

New Member
Joined
Apr 23, 2019
Messages
7
It doesn't matter on which sheet you perform the execution.
Try this:

VBA Code:
Sub Copy_Missing_Rows()
  With Sheets("JiraData")
    If .AutoFilterMode Then .AutoFilterMode = False
    If .FilterMode Then .ShowAllData
    .Range("A1:I" & .Range("I" & Rows.Count).End(xlUp).Row).AutoFilter 9, "Missing"
    .AutoFilter.Range.Range("A2:H" & .Range("I" & Rows.Count).End(xlUp).Row).Offset(1).Copy
    With Sheets("Dash")
      If .AutoFilterMode Then .AutoFilterMode = False
      If .FilterMode Then .ShowAllData
      .Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial xlValues
      .Range("A" & .Range("A" & Rows.Count).End(xlUp)(2).Row & ":A" & .Range("B" & Rows.Count).End(xlUp).Row).Value = Date
    End With
    If .AutoFilterMode Then .AutoFilterMode = False
  End With
  Application.CutCopyMode = False
End Sub

Thank you, the error is eliminated. :)

Still, the filter stays on in "JiraData" and I'd like to see all entries in "JiraData" after running the copy-macro. Any ideas? I've attached a snippet.
 

Attachments

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,181
Office Version
2007
Platform
Windows
Still, the filter stays on in "JiraData"
That is because you have the range in a table.

Try this:
VBA Code:
Sub Copy_Missing_Rows()
  Application.ScreenUpdating = False
  With Sheets("JiraData")
    If .AutoFilterMode Then .AutoFilterMode = False
    If .FilterMode Then .ShowAllData
    .Range("A1:I" & .Range("I" & Rows.Count).End(xlUp).Row).AutoFilter 9, "Missing"
    .AutoFilter.Range.Range("A2:H" & .Range("I" & Rows.Count).End(xlUp).Row).Offset(1).Copy
    With Sheets("Dash")
      If .AutoFilterMode Then .AutoFilterMode = False
      If .FilterMode Then .ShowAllData
      .Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial xlValues
      .Range("A" & .Range("A" & Rows.Count).End(xlUp)(2).Row & ":A" & .Range("B" & Rows.Count).End(xlUp).Row).Value = Date
    End With
    If .AutoFilterMode Then .AutoFilterMode = False
    On Error Resume Next
    .ShowAllData
  End With
  Application.CutCopyMode = False
End Sub
 

randomintel

New Member
Joined
Apr 23, 2019
Messages
7
That is because you have the range in a table.

Try this:
VBA Code:
Sub Copy_Missing_Rows()
  Application.ScreenUpdating = False
  With Sheets("JiraData")
    If .AutoFilterMode Then .AutoFilterMode = False
    If .FilterMode Then .ShowAllData
    .Range("A1:I" & .Range("I" & Rows.Count).End(xlUp).Row).AutoFilter 9, "Missing"
    .AutoFilter.Range.Range("A2:H" & .Range("I" & Rows.Count).End(xlUp).Row).Offset(1).Copy
    With Sheets("Dash")
      If .AutoFilterMode Then .AutoFilterMode = False
      If .FilterMode Then .ShowAllData
      .Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial xlValues
      .Range("A" & .Range("A" & Rows.Count).End(xlUp)(2).Row & ":A" & .Range("B" & Rows.Count).End(xlUp).Row).Value = Date
    End With
    If .AutoFilterMode Then .AutoFilterMode = False
    On Error Resume Next
    .ShowAllData
  End With
  Application.CutCopyMode = False
End Sub
Good morning.
Thank you for the effort. Unfortunately, this didn't solve the issue. Still, given the cost/benefit of this, I'd like to just say thank you and instruct the users to manually turn off the filters.

You have been instrumental in this, thank you. Have a great start to your week! :)
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,181
Office Version
2007
Platform
Windows
to manually turn off the filters.
In my tests the filters are off, try the following:

VBA Code:
Sub Copy_Missing_Rows()
  Application.ScreenUpdating = False
  With Sheets("JiraData")
    If .AutoFilterMode Then .AutoFilterMode = False
    If .FilterMode Then .ShowAllData
    .Range("A1:I" & .Range("I" & Rows.Count).End(xlUp).Row).AutoFilter 9, "Missing"
    .AutoFilter.Range.Range("A2:H" & .Range("I" & Rows.Count).End(xlUp).Row).Offset(1).Copy
    With Sheets("Dash")
      If .AutoFilterMode Then .AutoFilterMode = False
      If .FilterMode Then .ShowAllData
      .Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial xlValues
      .Range("A" & .Range("A" & Rows.Count).End(xlUp)(2).Row & ":A" & .Range("B" & Rows.Count).End(xlUp).Row).Value = Date
    End With
    If .AutoFilterMode Then .AutoFilterMode = False
    On Error Resume Next
    .ShowAllData
    .ListObjects(1).AutoFilter.ShowAllData
    .ListObjects(1).Range.AutoFilter
  End With
  Application.CutCopyMode = False
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,102,344
Messages
5,486,310
Members
407,539
Latest member
ltwkuav

This Week's Hot Topics

Top