Compile a list from 1 worksheet and copy or populate a new worksheet within the workbook

Hi cblgod1

Welcome to the Forum!!!

In your Sample File, what is the Room (perhaps Water Heater?)? What is the Location (perhaps Safety Sticker?)?

Hi cblgod1

I assumed such...get back to you.

Hi cblgod1

This Code is in the attached. All Code is in the Code Module for Sheet Checklist. Let me know of issues.

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
  Dim myLocation As String
  Dim wsSrc As Worksheet, wsTgt As Worksheet
  Dim lrTgt As Long
  Dim Rng As Range

  Set wsSrc = ActiveSheet
  Set wsTgt = Sheets("Template")  'Change this to your actual outoput Sheet Name

  If Target.Cells.Count > 1 Then Exit Sub
  Set Rng = Union([C7:C16], [C18:C22], [C24:C31], [F7:F22], [F24:F29], _
                  [I7:I11], [I13:I22], [I24:I25], [I27:I28], [I30:I32])
  If Not Intersect(Target, Rng) Is Nothing Then
    Select Case Target.Value
    Case "Watch", "Replace/Repair"
      'From http://www.tushar-mehta.com/publish_train/xl_vba_cases/1001%20range.find%20and%20findall.shtml#_Using_the_SearchFormat

      'Find Room Caption
      With Application.FindFormat
        .Clear
        With .Interior
          .ThemeColor = xlThemeColorDark1
          .TintAndShade = -0.349986266670736
        End With
      End With

      'Room Name
      myLocation = Cells.Find(What:="", after:=ActiveCell, LookIn:=xlFormulas, _
                              LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
                              MatchCase:=False, SearchFormat:=True).Offset(0, -2).Address
      With wsTgt
        lrTgt = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious).Row + 1
        .Cells(lrTgt, "A").Value = wsSrc.Range(myLocation).Value  'Room
        .Cells(lrTgt, "B").Value = wsSrc.Range(Target.Address).Offset(0, -2).Value  'Location
        .Columns("A:I").Columns.AutoFit
      End With
    Case Else
      'Do Nothing
    End Select
  End If
End Sub


Private Sub CommandButton1_Click()
  Dim wsSrc As Worksheet, wsTgt As Worksheet
  Dim Rng As Range
  Dim LR As Long

  Set wsSrc = Sheets("Checklist")
  Set wsTgt = Sheets("Template")  'Change this to your actual outoput Sheet Name

  With wsSrc
    Application.EnableEvents = False
    Set Rng = Union(.[C7:C16], .[C18:C22], .[C24:C31], .[F7:F22], .[F24:F29], _
                    .[I7:I11], .[I13:I22], .[I24:I25], .[I27:I28], .[I30:I32])
    Rng.ClearContents
    Application.EnableEvents = True
  End With

  With wsTgt
    LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                     SearchDirection:=xlPrevious).Row
    If LR = 2 Then LR = 3
    .Range("A3:I" & LR).ClearContents
  End With
End Sub