Solved

fill down range to match another for all worksheets in two workbooks

Posted on 2012-03-23
13
346 Views
Last Modified: 2012-04-11
I have one workbook that collects data from a DDE link. (datacollect240). I have another that stores the data (Databank240)
I would like a macro that fills down the new data from datacollect240 into each matching worksheet in Databank240.

This macro works for the Sheet EURUSD but I have 27 worksheets with different currency pairs.

Sub CopyRowsByDate_EURUSD()
    Dim searchDate, searchTime
    Dim wb1, wb2, pos, lastrow
    Set wb1 = Workbooks("dataCollect240.xlsm").Sheets("EURUSD") 'Please adapt to original name
    Set wb2 = Workbooks("Databank2400.xlsm").Sheets("EURUSD") 'Please adapt to original name
   
    wb2.Activate
   
    lastrow = wb2.Cells(Rows.Count, 1).End(xlUp).Row
    searchDate = Cells(lastrow, 1)
    searchTime = Cells(lastrow, 2)
    wb1.Columns(2).NumberFormat = "hh:mm"
    wb2.Columns(2).NumberFormat = "hh:mm"
    wb2.Columns(1).NumberFormat = "dd/mm/yyyy"

   
    With wb1.[A1] 'Set temporarely autofilters at wb1
        .AutoFilter Field:=1, Criteria1:=searchDate
        .AutoFilter Field:=2, Criteria1:=Format(searchTime, "hh:mm")
        End With
    pos = wb1.[A1].End(xlDown).Row
    If pos < Rows.Count Then
        wb1.AutoFilterMode = False 'deactivate autofilter
        wb1.Rows(pos & ":400").Copy
        wb2.Cells(lastrow, 1).Select
        Selection.PasteSpecial xlPasteValues
        Application.CutCopyMode = False


    Else
        wb1.AutoFilterMode = False 'deactivate autofilter
        MsgBox "Last date and time not found in WB1 !"
    End If
   
End Sub


Therefore, I would like one macro that runs through the whole workbook

Thanks
Chris
Databank240.xlsm
DataCollect240.xlsm
0
Comment
Question by:CC10
  • 7
  • 4
  • 2
13 Comments
 
LVL 19

Expert Comment

by:regmigrant
Comment Utility
If you are happy with how the macro works for one sheet you can generalise it by passing it a sheet parameter and then have a separate block loop through all the sheets in Databank and pass each sheet to it.

For example:
    Dim file1 As Workbook
    Dim file2 As Workbook
    Dim isheet as Worksheet

    Set file1 = Workbooks.Open(<databank file with path>)
    Set file2 = Workbooks.Open(<datacollect file with path>)

For each isheet in file1
     Call CopyRowsByDate(file1.sheets(isheet), file2.sheets(isheet))
Next isheet


You will need to change your sub to:


Sub CopyRowsByDate(wsIn as Worksheet, wsOut as Worksheet)
Then where you have used Wb1, Wb2 use the input (wsIn)  or output (wsOut) as appropriate


If no-one else jumps in I will provide a more complete example when I have more time

This asusmes both workbooks have the identical set of sheet names

Reg
0
 

Author Comment

by:CC10
Comment Utility
I'm a bit confused on this. Do I need a separate macro to call the Sub Copy RowsByDate?
0
 
LVL 19

Assisted Solution

by:regmigrant
regmigrant earned 100 total points
Comment Utility
yes, If you started by creating a macro you may have that stored in one of the worksheets (which is generally used for macros specific to the sheet) or the workbook (which is generally used for macros attached to Workbook events like open/close).
A standard module is the best place to store macro's that apply to all sheets in the workbook. As long as you have different names for each Macro vba will keep track of which bit of code it needs to work with

In the vb editor create a standard module (if you haven't already got one) and put your existing code in there then add the 'wrapper' to the same module.
you are aiming for something like:

    Sub processall sheets()
         'some code
         Call CopyRowsByDate(.....)
        ' more code
    End sub
_________________________________________________________________  ' vba editor will add the line
    Sub CopyRowsByDate(wsin as worskheet, wsout as worksheet)
      ' your modified code
    End sub

Its possible to do the whole thing in one macro of course but structuring like this makes life easier when debugging (you are dealing with limited amounts of code) and is more flexible (you can call the subroutine under other circumstances without going through all the worksheets).

However If you are more comfortable with a single block then apply the same idea but include all your existing code inside the loop:

For each isheet in file1
    'do all the copy row stuff
next isheet

Reg
0
 

Author Comment

by:CC10
Comment Utility
hopefully the last question. Since the workbooks are already open, what should I replace here:

Set file1 = Workbooks.Open(<databank file with path>)
    Set file2 = Workbooks.Open(<datacollect file with path>)
0
 

Author Comment

by:CC10
Comment Utility
I have rewritten the macro as follows but it is clear it cannot work as the macro is in the workbook "Databank240" and both workbooks are already open. What do I have to replace in lines?

Set file1 = Workbooks.Open("dataCollect240.xlsm")
    Set file2 = Workbooks.Open("Databank240.xlsm")

Option Explicit


Sub processAllSheets()

Dim file1 As Workbook
    Dim file2 As Workbook
    Dim isheet As Worksheet

    Set file1 = Workbooks.Open("dataCollect240.xlsm")
    Set file2 = Workbooks.Open("Databank240.xlsm")

For Each isheet In file1
     Call CopyRowsByDate(file1.Sheets(isheet), file2.Sheets(isheet))
Next isheet

End Sub

Sub CopyRowsByDate(wsIn As Worksheet, wsOut As Worksheet)
    Dim searchDate, searchTime
    Dim wsIn, wsOut, pos, lastrow
 
    Dim file1 As Workbook
    Dim file2 As Workbook
    Dim isheet As Worksheet

    Set file1 = Workbooks.Open("dataCollect240.xlsm")
    Set file2 = Workbooks.Open("Databank2400.xlsm")
   
    For Each isheet In file1
     Call CopyRowsByDate(file1.Sheets(isheet), file2.Sheets(isheet))
Next isheet
   
   
    'wsOut.Activate
   
    lastrow = wsOut.Cells(Rows.Count, 1).End(xlUp).Row
    searchDate = Cells(lastrow, 1)
    searchTime = Cells(lastrow, 2)
    wsIn.Columns(2).NumberFormat = "hh:mm"
    wsOut.Columns(2).NumberFormat = "hh:mm"
    wsOut.Columns(1).NumberFormat = "dd/mm/yyyy"

   
    With wsIn.[A1] 'Set temporarely autofilters at wsIn
        .AutoFilter Field:=1, Criteria1:=searchDate
        .AutoFilter Field:=2, Criteria1:=Format(searchTime, "hh:mm")
        End With
    pos = wsIn.[A1].End(xlDown).Row
    If pos < Rows.Count Then
        wsIn.AutoFilterMode = False 'deactivate autofilter
        wsIn.Rows(pos & ":400").Copy
        wsOut.Cells(lastrow, 1).Select
        Selection.PasteSpecial xlPasteValues
        Application.CutCopyMode = False


    Else
        wsIn.AutoFilterMode = False 'deactivate autofilter
        MsgBox "Last date and time not found in wsIn !"
    End If
   
End Sub
0
 
LVL 20

Expert Comment

by:ElrondCT
Comment Utility
I presume this isn't actually your code, because CopyRowsByDate calls itself (it looks like you copied code from processAllSheets into CopyRowsByDate, and got too much).

Are these workbooks open in a different instance of Excel? If they're open in the current instance, Workbooks.Open should still work (I do it in macro that I use regularly). What error are you getting and exactly which line is giving the error (walk through with the debugger if necessary)?
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:CC10
Comment Utility
The CopyRowsByDate macro does not work at all now. I have included both workbooks as I really cannot solve this on my own.
Databank240.xlsm
DataCollect240.xlsm
0
 

Author Comment

by:CC10
Comment Utility
Is there any further information that you need? I have increased the points to 500.
0
 
LVL 20

Expert Comment

by:ElrondCT
Comment Utility
My knowledge of Excel macros is only intermediate-level, so I'm running into some problems trying to get this working. I can tell you that you definitely need to eliminate
    Dim file1 As Workbook
    Dim file2 As Workbook
    Dim isheet As Worksheet

    Set file1 = Workbooks.Open("dataCollect240.xlsm")
    Set file2 = Workbooks.Open("Databank2400.xlsm")
   
    For Each isheet In file1
     Call CopyRowsByDate(file1.Sheets(isheet), file2.Sheets(isheet))
Next isheet

Open in new window

from CopyRowsByDate. This section is copied from the first macro, and it's referring back to itself to create a recursive loop. Also, you don't want to do a .Open, because as you've said, the worksheets are already open. You can

    Set file1 = ThisWorkbook

to do the assignment of the name. However, at the moment I'm getting some flaky results with xlDown and xlUp operations, and I've got to get to bed. I'm not sure if I'll have time tomorrow to look at this. Perhaps this limited information will allow you to start trying some things yourself.
0
 

Author Comment

by:CC10
Comment Utility
I really appreciate your efforts to help. I am now travelling for the next couple of days and will get back to you when I have tried a few things by myself. I don't have computer access again until Monday. In the meantime,
Happy Easter!

CC
0
 
LVL 20

Accepted Solution

by:
ElrondCT earned 400 total points
Comment Utility
OK, I think it's working properly. Try the following:
Sub processAllSheets()

    Dim iSheet As Worksheet

For Each iSheet In Workbooks("dataCollect240.xlsm").Sheets
     Call CopyRowsByDate(iSheet.Name)
Next iSheet

End Sub

Sub CopyRowsByDate(strSheet As String)
    Dim searchDate, searchTime
    Dim wsIn, wsOut, pos, lastrow
    Set wsIn = Workbooks("dataCollect240.xlsm").Sheets(strSheet)
    Set wsOut = Workbooks("Databank240.xlsm").Sheets(strSheet)
    wsOut.Activate
   
    lastrow = wsOut.Cells(Rows.Count, 1).End(xlUp).Row
    searchDate = Cells(lastrow, 1)
    searchTime = Cells(lastrow, 2)
    wsIn.Columns(2).NumberFormat = "hh:mm"
    wsOut.Columns(2).NumberFormat = "hh:mm"
    wsOut.Columns(1).NumberFormat = "dd/mm/yyyy"
   
    With wsIn.[A1] 'Set temporarely autofilters at wsIn
        .AutoFilter Field:=1, Criteria1:=searchDate
        .AutoFilter Field:=2, Criteria1:=Format(searchTime, "hh:mm")
        End With
    pos = wsIn.[A1].End(xlDown).Row
    If pos < Rows.Count Then
        wsIn.AutoFilterMode = False 'deactivate autofilter
        wsIn.Rows(pos & ":400").Copy
        wsOut.Cells(lastrow, 1).Select
        Selection.PasteSpecial xlPasteValues
        Application.CutCopyMode = False

    Else
        wsIn.AutoFilterMode = False 'deactivate autofilter
        MsgBox "Last date and time not found in wsIn !"
    End If
   
End Sub

Open in new window


I've kept as much of your code as possible. The file names are hardcoded, but that shouldn't be too difficult to change if needed. It seems to work properly on my computer to copy the data from DataCollect to DataBank.
0
 

Author Closing Comment

by:CC10
Comment Utility
Elron, I awarded the first expert 100 points for the initial solution but he did not follow up, and 400 for you as you solved it. Hope thats OK with you.

Thanks again.
0
 
LVL 20

Expert Comment

by:ElrondCT
Comment Utility
That's fully appropriate. He did provide substantial assistance, and he should be recognized for that. I'm glad everything is working for you.
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

What is a Form List Box? (skip if you know this) The forms List Box is the alternative to the ActiveX list box. If you are using excel 2007, you first make sure you have a developer tab (click the Orb)->"Excel Options"->Popular->"Show Developer tab…
Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now