CODEWITHSUNDEEP
excelcopyconditional-statementsvba
LudivousKain
LudivousKain

Reputation: 3

excel macro to conditionally copy specific cells from another workbook

I've spent just about the whole day today (8 hours at least) trying to find an answer to my dilemma, but I'm at my wits' end. Here's the scenario and issue:

Scenario: We have one equipment workbook (Equipment Log.xlsx). That workbook has 6 worksheets (Sheet1, Sheet2,.....). Each sheet has different "headings" in row 1, but all sheets have several headings in common and in the exact same columns (ID, Facility, Building, Division, Department, and Room) along with one who's position is different in each workbook (Due).

Issue: I need to have a separate Excel workbook (or as a LAST resort, add a 7th worksheet to the equipment log) which, either upon opening or once the user clicks on a specific cell, will then go through the original equipment log file, look at each equipment's "Due" date, and if it falls within 30 days from "Today()" will copy "ID, Facility, Building, Division, Department, Room, and Due" to designated cells in the active worksheet.

I have SOME experience with macros, but it's VERY limited. I took JAVA-101 in college, but I never continued more than that.

I'm VERY open-minded with this project.

Thanks for taking the time to read, and THANKS+++ for taking the time to respond.

Upvotes: 0

Views: 8589

Answers (1)

dosdel
dosdel

Reputation: 1138

I'm a bit bored, so I figured I'd whip up something to help you out:

This code will look in the Equipment Log workbook and loop through each worksheet, evaluating the due date against today's date... It will then copy the info from the cells you mentioned into the next row of whichever workbook you run this code from. You will likely have to make some adjustments, but it should be a good start.

Sub equipLog()

Dim eqWb As Workbook
Dim sh1 As Worksheet
Dim due, ID, fac, bldg, div, dept, room
Dim dateDue As Date
Dim rArr As Variant
Dim ws As Worksheet

Set sh1 = ThisWorkbook.Sheets("Sheet1")
Set eqWb = Workbooks.Open("C:\Code3\Equipment Log.xlsx") ' change this to your equipment sheet path

wsNums = eqWb.Worksheets.Count

    For Each ws In eqWb.Worksheets
        ws.Activate
        Set due = Cells.Find("Due")
        Set ID = Cells.Find("ID")
        Set room = Cells.Find("Room")
        lrEq = Range("A" & Rows.Count).End(xlUp).Row
        For i = (due.Row + 1) To lrEq
            dateDue = Cells(i, due.Column)
            dd = DateDiff("d", Date, dateDue)
            If Abs(dd) < 30 Then
                ' I'm assuming that the cells are all located in a row in the order you mentioned
                rArr = Range(Cells(ID.Row + 1, ID.Column), Cells(room.Row + 1, room.Column))
                x = 1
                lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
                For Each c In rArr
                    sh1.Cells(lr + 1, x) = c
                    x = x + 1
                Next c
                sh1.Cells(lr + 1, x + 1) = dateDue
            End If
        Next i
    Next ws
End Sub

Upvotes: 1

Related Questions