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

[cblgod1]

I am attaching the file in its current state........ All of the info needed is on the comments page or 2 page in the workbook.
Any help will be greatly appreciated.

The request, for others that may search for the same answer is.......

Need a list to populate on another worksheet using data (conditions) from another.

Example.
Need all Locations, that need repair/replacing or need to be watched, to populate a list on another worksheet. Which will allow
the technician to type in comments on the repair needed. Then print it and add to the service contract.

I also need it to adjust the list to fit as many locations as necessary.


Thanks a mil!

[jaslake]

Hi cblgod1

Welcome to the Forum!!!

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

[cblgod1]

Room= kitchen, bathroom, etc.
Location= faucet, valve, etc.

[jaslake]

Hi cblgod1

I assumed such...get back to you.

[jaslake]

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