1

My company uses Excel to track inspections and maintenance of portable fire extinguishers and I'm trying to add some functionality to it but don't have the first clue about how to do it. I'll do my best to explain what I need assistance with:

All three sheets will have the same column headings in row 1. On the first and second sheets in the workbook (titled "Monthly" and "Annual" respectively), I am using conditional formatting to color cells in columns Y and AC based upon there values as determined by a formula (Yellow if the calculation returns a value less than 90, Red if the value returned is 0 or a negative number).

What I would like a macro to do is to copy the entire row from column A through column AD to a third sheet (titled "Maint Due"). It would also be nice if this process were automated so that anytime the values in columns Y and AC changed in the "Monthly" or "Annual" sheets, the information in the "Maint Due" sheet was automatically updated (but if I have to rerun the macro manually for that to happen it's not a big deal).

Hopefully I've explained what I'm trying to do in a way that it makes sense to someone and they can offer help. I have very little coding experience and it's been 15 years since I've really done any coding so I'm very rusty. I appreciate any advice or assistance folks may be able to give.!

EDIT:

I've never used the Macro recorder and I can only figure out how to create a macro to copy and paste, so I had no luck there. After doing some more searching and watching some videos I cobbled this together:

Sub Show_on_Maint()
x = 2
'Sets the starting row
Do While Cells(x, 2) <> ""
    'Continue to evaluate until a blank cell is reached
    If Cells(x, 25) <= 90 Then
        'Evaluates the cell in column Y to determine if the value is less than or equal to 90
        Sheets("Sheet1").Rows(x).Copy Sheets("Sheet6").Range("A2")
        'Copies the row to the Maint Due sheet
    Else
        If Cells(x, 29) <= 90 Then
            'Evaluates the cell in column AC to determine if the value is less than or equal to 90
            Sheets("Sheet1").Rows(x).Copy Sheets("Sheet6").Range("A2")
            'Copies the row to the Maint Due sheet
        End If
    End If
    x = x + 1
Loop
End Sub

When I run/debug it I get a Loop without Do error. I think my logic is sound but I don't have enough experience to figure out why I'm getting that error.

EDIT: Missing End If before x = x + 1

Now I receive a runtime error 9 "Subscript out of range" at: Sheets("Sheet1").Rows(x).Copy Sheets("Sheet6").Range("A2")

Screenshot
(Click image to enlarge)

3
  • 1
    This is entirely possible, but we'll need you to give it a shot. Show us where you get stuck. Try using the macro recorder first. Dec 19, 2014 at 13:03
  • What will happen in sheet3? If I change a value in Sheet1, the row is copied to Sheet3. If I then change another value in Sheet1, this is also copied to Sheet3. Does this mean there are 2 values in Sheet3 now?
    – Dave
    Dec 19, 2014 at 13:29
  • You stated Red if the value returned is 0 or a negative number but AC12 is 13 and it is colored red.
    – user385793
    Dec 20, 2014 at 0:28

1 Answer 1

0

You've mentioned that you would like this to automatically copy the information to the Maint Due, so I will work with that. A Worksheet change event macro could cover the automation but you would need one for each of the Monthly and Annual worksheets. I'll suggest a Workbook_SheetChange that parses the source worksheet looking for either Monthly or Annual.

Tap Alt+F11 and when the VBE opens, look to the Project Explorer on the left-hand side for ThisWorkbook. If you don't have the Project Explorer open tap Ctrl+R to show it. Right-click ThisWorkbook and choose View Code. In the new pane to the right titled something like Book1 - ThisWorkbook (Code) paste the following.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If LCase(Sh.Name) = "monthly" Or LCase(Sh.Name) = "annual" Then
        If Not Intersect(Target, Sh.Range("Y:Y, AC:AC")) Is Nothing Then
            On Error GoTo Fìn
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            Dim lc As Long, r As Range
            For Each r In Intersect(Target, Sh.Range("Y:Y, AC:AC"))
                If r.Value <= 90 Then
                    lc = Sh.Cells(1, Columns.Count).End(xlToLeft).Column
                    Sh.Cells(r.Row, 1).Resize(1, lc).Copy _
                      Destination:=Sheets("Maint Due").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                End If
            Next r
        End If
    End If
Fìn:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Tap Alt+Q to return to your workbook. Any new values typed into the Annual or Monthly worksheet's column Y or column AC will results in that line being copied to the next blank line in the Maint Due worksheet.

The first problem I see is that triggered event macros do not trigger on a formula's result being changed. There was some mention of columns Y and AC being calculated so the trigger might have to be on the column creating the value(s) in columns Y and AC, not columns Y and Ac themselves. Columns V and X look to be likely candidates.

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .