• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 374
  • Last Modified:

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

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
CC10
Asked:
CC10
  • 7
  • 4
  • 2
2 Solutions
 
regmigrantCommented:
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
 
CC10Author Commented:
I'm a bit confused on this. Do I need a separate macro to call the Sub Copy RowsByDate?
0
 
regmigrantCommented:
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
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
CC10Author Commented:
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
 
CC10Author Commented:
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
 
ElrondCTCommented:
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
 
CC10Author Commented:
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
 
CC10Author Commented:
Is there any further information that you need? I have increased the points to 500.
0
 
ElrondCTCommented:
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
 
CC10Author Commented:
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
 
ElrondCTCommented:
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
 
CC10Author Commented:
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
 
ElrondCTCommented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 7
  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now