Macro that moves an entire row from one sheet to another based on date in one cell and value in other cell.

[daoteez]

I use a spreadsheet to track when I need to call a client after a set period within a given territory. Each client territory is represented on a different sheet within my workbook. I already have a macro that can move a client, represented by a row of data, between any of the sheets of the workbook based on a drop-down selection within that row. After I have met with a client I will move them to an “on hold” sheet in the workbook.

On this “on hold” sheet I have an expiration date next to each client data row of when I need to contact each respective client next. What I’m looking for is a macro that will recognize that expiration date on a given client row of data and automatically move that client data back to its respective territory sheet based on a respective cell within that client row once that expiration date has been met. The reference cell would have the name of the territory the client belongs to. E.g. Los Angeles or Pasadena.

 

[daoteez]

We can set the dropdown value directly to sheet name.

Oh perfect! That makes way more sense anyway. I’ll test this out as soon as I see the updated macro.

 

[Legacy 143009]

I hope this will work. I haven't tested it. Please read my comments to modify yourself.

Sub moveClient()
  Dim lRow As Long
  With Worksheets("On Hold")
  lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row in "On Hold" sheet
  For i = 2 To lRow 'Loop until last row
    If .Cells(i, 18).Value < Now Then 'If column R (Exp. Date) value older than today
      For Each ws In Worksheets ' For each worksheet
        If Left(ws.Name, InStr(1, ws.Name, "-") - 1) = .Cells(i, 7).Value Then 'If sheet number equals to column G (Region) value
          .Cells(i, 3).Value = ws.Name 'Set dropdown value in column C to Sheet Name
          Rows(i).Cut 'Cut the entire row
          ws.Cells(Rows.Count, 1).End(xlUp).Offset(1).Insert 'Insert to end of Region sheet
          Exit For 'Exit looping sheets and move to the next record in "On Hold" sheet
        End If
      Next
    End If
  Next
  End With
End Sub

 

[daoteez]

I hope this will work. I haven't tested it. Please read my comments to modify yourself.

Sub moveClient()
  Dim lRow As Long
  With Worksheets("On Hold")
  lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row in "On Hold" sheet
  For i = 2 To lRow 'Loop until last row
    If .Cells(i, 18).Value < Now Then 'If column R (Exp. Date) value older than today
      For Each ws In Worksheets ' For each worksheet
        If Left(ws.Name, InStr(1, ws.Name, "-") - 1) = .Cells(i, 7).Value Then 'If sheet number equals to column G (Region) value
          .Cells(i, 3).Value = ws.Name 'Set dropdown value in column C to Sheet Name
          Rows(i).Cut 'Cut the entire row
          ws.Cells(Rows.Count, 1).End(xlUp).Offset(1).Insert 'Insert to end of Region sheet
          Exit For 'Exit looping sheets and move to the next record in "On Hold" sheet
        End If
      Next
    End If
  Next
  End With
End Sub

It gave me an error stating "variable not defined" not sure how to fix that.

 

[Legacy 143009]

You should send the sample book you create. Please upload via wetransfer.

 

[daoteez]

You should send the sample book you create. Please upload via wetransfer.

 

[daoteez]

Sure thing, take a look at the link below. Hopefully that works!

Sandbox Mail Merge Database.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[Legacy 143009]

Ohh bravo Actually your code does a good job after changing the name. So there is no need for me to move. Changing the status is enough. Also, I did one minor modification, stepping backward which is always more robust for cutting-inserting processes.
Variable is not defined error is because you use option explicit so you have to declare all variables with types explicitly.
Here find the working code:

Sub moveClient()
  Dim lRow As Long, i As Long, ws As Worksheet
  With Worksheets("On Hold")
  lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row in "On Hold" sheet
  For i = lRow To 2 Step -1 'Loop from last row
    If .Cells(i, 18).Value < Now Then 'If column R (Exp. Date) value older than today
      For Each ws In Worksheets ' For each worksheet
        If InStr(ws.Name, "-") > 0 Then
          If CInt(Left(ws.Name, InStr(1, ws.Name, "-") - 1)) = .Cells(i, 7).Value Then 'If sheet number equals to column G (Region) value
            .Cells(i, 3).Value = ws.Name 'Set dropdown value in column C to Sheet Name
            Exit For 'Exit looping sheets and move to the next record in "On Hold" sheet
          End If
        End If
      Next
    End If
  Next
  End With
End Sub

 

[daoteez]

Ohh bravo Actually your code does a good job after changing the name. So there is no need for me to move. Changing the status is enough. Also, I did one minor modification, stepping backward which is always more robust for cutting-inserting processes.
Variable is not defined error is because you use option explicit so you have to declare all variables with types explicitly.
Here find the working code:

Sub moveClient()
  Dim lRow As Long, i As Long, ws As Worksheet
  With Worksheets("On Hold")
  lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row in "On Hold" sheet
  For i = lRow To 2 Step -1 'Loop from last row
    If .Cells(i, 18).Value < Now Then 'If column R (Exp. Date) value older than today
      For Each ws In Worksheets ' For each worksheet
        If InStr(ws.Name, "-") > 0 Then
          If CInt(Left(ws.Name, InStr(1, ws.Name, "-") - 1)) = .Cells(i, 7).Value Then 'If sheet number equals to column G (Region) value
            .Cells(i, 3).Value = ws.Name 'Set dropdown value in column C to Sheet Name
            Exit For 'Exit looping sheets and move to the next record in "On Hold" sheet
          End If
        End If
      Next
    End If
  Next
  End With
End Sub

This is phenomenal! There was two things that came up. Is there a way for this macro to auto run when the spreadsheet opens? There was also one unexpected issue that came up. If the date box is left blank the macro will automatically move the data row back to the corresponding territory. Is there a way for the macro to ignore a blank date cell?

 

[Legacy 143009]

Double click to ThisWorkbook in project explorer. Paste this into workbook. It will run with Open event.

Private Sub Workbook_Open()
  Dim lRow As Long, i As Long, ws As Worksheet
  With Worksheets("On Hold")
  lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row in "On Hold" sheet
  For i = lRow To 2 Step -1 'Loop from last row
    If .Cells(i, 18).Value <> "" And .Cells(i, 18).Value < Now Then 'If column R (Exp. Date) value different than empty and older than today
      For Each ws In Worksheets ' For each worksheet
        If InStr(ws.Name, "-") > 0 Then
          If CInt(Left(ws.Name, InStr(1, ws.Name, "-") - 1)) = .Cells(i, 7).Value Then 'If sheet number equals to column G (Region) value
            .Cells(i, 3).Value = ws.Name 'Set dropdown value in column C to Sheet Name
            Exit For 'Exit looping sheets and move to the next record in "On Hold" sheet
          End If
        End If
      Next
    End If
  Next
  End With
End Sub

 

[daoteez]

Double click to ThisWorkbook in project explorer. Paste this into workbook. It will run with Open event.

Private Sub Workbook_Open()
  Dim lRow As Long, i As Long, ws As Worksheet
  With Worksheets("On Hold")
  lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row in "On Hold" sheet
  For i = lRow To 2 Step -1 'Loop from last row
    If .Cells(i, 18).Value <> "" And .Cells(i, 18).Value < Now Then 'If column R (Exp. Date) value different than empty and older than today
      For Each ws In Worksheets ' For each worksheet
        If InStr(ws.Name, "-") > 0 Then
          If CInt(Left(ws.Name, InStr(1, ws.Name, "-") - 1)) = .Cells(i, 7).Value Then 'If sheet number equals to column G (Region) value
            .Cells(i, 3).Value = ws.Name 'Set dropdown value in column C to Sheet Name
            Exit For 'Exit looping sheets and move to the next record in "On Hold" sheet
          End If
        End If
      Next
    End If
  Next
  End With
End Sub

This is flawless, thank you so much for your help it's very appreciated!