VBE script (Excel 2000)

[jervismith]

I must begin by saying that my understanding of the advanced features of Excel is very limited. I am wondering if it is possible to use VBE to pull data from one Excel workbook and input it in another.

For instance the attached workbook gives a very basic example of a Tracking Log that my company will be compiling over the course of several months. The Tracking Log will include thousands of entries (rows). Each entry will have a status of either "open" or "closed". A second (separate) workbook, which I'll call the Update List, will need to be updated daily to show all entries from the Tracking Log that are still "open" (this will include entries that have never been closed, and entries that have been reopened after being closed).

Would it be possible to write VBE script that would enable the Update List workbook to pull all entries (by row) that are "open" from the Tracking Log workbook?
If so, could someone help me write this script?

Thank you,

Alec Smith

[HansV]

Welcome to Woody's Lounge!

You could use the following macro, stored in a module in the workbook with the data:

Sub CopyOpenList()
Dim wbkSrc As Workbook
Dim wshSrc As Worksheet
Dim wbkTrg As Workbook
Dim wshTrg As Worksheet
Dim s As Long
Dim m As Long
Dim t As Long
Set wbkSrc = ThisWorkbook
Set wshSrc = wbkSrc.Worksheets("Sheet1")
Set wbkTrg = Workbooks.Open("Update List.xls")
Set wshTrg = wbkTrg.Worksheets(1)
wshTrg.Cells.ClearContents
wshSrc.Rows(1).Copy wshTrg.Range("A1")
m = wshSrc.Range("B65536").End(xlUp).Row
t = 1
For s = 2 To m
If LCase(wshSrc.Range("B" & s)) = "open" Then
t = t + 1
wshSrc.Rows(s).Copy wshTrg.Range("A" & t)
End If
Next s
wbkTrg.Close True
End Sub

Change the name of the target workbook ("Update List.xls") as needed. If it is not stored in your default Excel folder, add the path of the workbook.

[LegareColeman]

I started working on this earlier this afternoon and before I finished I had to leave for a couple of hours. When I returned I finished it and then noticed that Hans had posted a reply. I decided to go ahead and post my solution since I have a few more bells and whistles and some additional error checking.

Your description of what you wanted was a little unclear on a number of points:

1- You did not say if the new log file contained all of the open items or if it just contained new open items and if the open items should be added to any existing update list or if any previous list should be cleared before copying the items from the current file. My code assumes that any the update list should be cleared before copying the new items.

2- You did not say how to find the log file with the new items. My code displays an Open dialog box to let you select the log file.

3- My code assumes that the Update List workbook will be the active workbook when the macro is executed. The macro can be located in this workbook, or in your Personal.xls.

Here is my code:

<code>
Public Sub GetOpenItems()
Dim oWBLog As Workbook, oWSU As Worksheet, oWSL As Worksheet
Dim vLogFilePath As Variant
Dim lLastRow As Long, I As Long, j As Long
On Error Resume Next
Set oWSU = Worksheets("Update List")
On Error GoTo 0
If oWSU Is Nothing Then
Worksheets("Sheet1").Name = "Update List"
Set oWSU = Worksheets("Update List")
End If
vLogFilePath = Application.GetOpenFilename(FileFilter:="(*.xls),* .xls,(*.*),*.*", Title:="Select Log File")
If VarType(vLogFilePath) = vbBoolean Then
Exit Sub
End If
Set oWBLog = Workbooks.Open(Filename:=vLogFilePath)
Set oWSL = oWBLog.Worksheets("Sheet1")
oWSU.Cells.Clear
oWSL.Range("1:1").Copy
oWSU.Paste Destination:=oWSU.Range("A1")
Application.CutCopyMode = False
lLastRow = oWSL.Range("A65536").End(xlUp).Row - 1
j = 0
For I = 1 To lLastRow
If oWSL.Range("A1").Offset(I, 1).Value = "Open" Then
oWSL.Range("A1").Offset(I, 0).EntireRow.Copy
oWSU.Paste Destination:=oWSU.Range("A2").Offset(j, 0)
j = j + 1
End If
Next I
oWSU.Range("A1:IV" & j).EntireColumn.AutoFit
Application.CutCopyMode = False
oWBLog.Close
End Sub
</code>

[jervismith]

Thank you very much for taking the time to write out this script for me.

This website is amazing!

- Alec

[jervismith]

Legare Coleman, thank you for your help. I am very impressed with the skills of the people on this site, and grateful for your willingness to help.

- Alec Smith