VBA - Find Open Workbook and Paste data

[Nordicrx8]

Hi all!


I'm trying to simplify a process to save time. I have a master file that converts several reports into one. It transforms the data and spits out tailored data for each of market areas my company supports. I have to then copy multiple selections into several other workbooks, which is time consuming. What I'd like to do is have it be a one button click to copy all the fields I need per market.

Primary ask: I want the code to search all open workbooks for a matching name. I have 7 Markets, and two components of the file name are dynamic. (Month & Market name)

MASTER FILE
Name: SLMR Master
Market Name Location: E2
Current Month Location: K2
Current Date Location: E6

Market Workbooks
Name: Service Level Miss (MONTH) MTD (Market Name)

Once it finds the matching Workbook, I want it to copy data from this location:

Workbook Name: SLMR Master
Tab Name: Main
Data Location: F6:AD6
Date Location: E6

To Location:

Workbook Name: Service Level Miss (MONTH) MTD (Market Name)
Tab Name: MTD Template
Data Location: C2:AA33
Date Location: B2:B33

The added twist here, is that once it finds the matching workbook, it needs to locate the correct date, and paste the data in the row.

I know this is a lot, and code will probably be complex, but if someone could help me get started I’d really appreciate it! If you need any additional information, please let me know.

Thanks so much for your time!

Best,
Chris

 

[Akuini]

I don't understand your data layout.
You want to copy B4:B39 to B3:M39? the row size are different, 4 to 39 and 3 to 39

 

[Nordicrx8]

I don't understand your data layout.
You want to copy B4:B39 to B3:M39? the row size are different, 4 to 39 and 3 to 39

I think I have it mostly figured out, but it's pasting over the header (Month) Do you know of a way to have the paste function to start one row down?

Sub Update_YTD()
  Dim foundCell As Range, sh1, sh2 As Worksheet
  
  Set sh1 = Sheets("MTD Performance")
  Set sh2 = Sheets("YTD Performance")
  
  Set foundCell = sh2.Range("B:M").Find(sh1.Range("A1").Value, , xlValues, xlWhole)
  If Not foundCell Is Nothing Then
    sh1.Range("B4:B39").Copy
    foundCell.PasteSpecial xlPasteValues
    foundCell.PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
  Else
    Call MsgBox("Data match not detected. Check MTD Performance Cell A1", vbExclamation, "Finding String")
  End If
End Sub

 

[Nordicrx8]

Oh! I got working! Woo!

Sub Update_YTD()
  Dim foundCell As Range, sh1, sh2 As Worksheet
  
  Set sh1 = Sheets("MTD Performance")
  Set sh2 = Sheets("YTD Performance")
  
  Set foundCell = sh2.Range("B:M").Find(sh1.Range("A1").Value, , xlValues, xlWhole)
  If Not foundCell Is Nothing Then
    sh1.Range("B4:B39").Copy
    foundCell.Offset(1, 0).PasteSpecial xlPasteValues
    foundCell.Offset(1, 0).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
  Else
    Call MsgBox("Data match not detected. Check MTD Performance Cell A1", vbExclamation, "Finding String")
  End If
End Sub

 

[Akuini]

Good job.
It looks like you're having fun learning VBA.

 

[Nordicrx8]

Good job.
It looks like you're having fun learning VBA.

I am! I wish I knew more, but this board has been a tremendous resource. Thanks again for all your help - I appreciate you!

 

[Nordicrx8]

Good job.
It looks like you're having fun learning VBA.

Hi Akuini!

I was hoping you could help me one last time! My workbook is shaping up quite nicely! Since others will be using this WB too, I wanted to add in a popup message box alerting the user if no matching open workbooks are found. Currently it pops a VBA error message if it doesn't find a match, which would cause confusion.

Thanks so much for all your help!

 

[Akuini]

Perhaps this would suffice:

Sub CP()
Dim wb1 As Workbook
Dim fm
On Error GoTo skip:
With Workbooks("SLMR Master - All Regions").Sheets("Main")
    Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
        fm = Application.Match(.Range("e7"), wb1.Sheets("MTD Template").Range("B2:B34"), 0)
         If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F7:AD7").Value

          End If


End With

'..rest of the original code here

Exit Sub


skip:
If Err.Number = 9 Then
    MsgBox "Can't find the workbook"
Else
    MsgBox Err.Description
End If

End Sub

 

[Nordicrx8]

Perhaps this would suffice:

Sub CP()
Dim wb1 As Workbook
Dim fm
On Error GoTo skip:
With Workbooks("SLMR Master - All Regions").Sheets("Main")
    Set wb1 = Workbooks("Service Level Miss " & .Range("k2") & " MTD " & .Range("e2"))
        fm = Application.Match(.Range("e7"), wb1.Sheets("MTD Template").Range("B2:B34"), 0)
         If IsNumeric(fm) Then
            wb1.Sheets("MTD Template").Range("C" & fm + 1 & ":AA" & fm + 1).Value = .Range("F7:AD7").Value

          End If


End With

'..rest of the original code here

Exit Sub


skip:
If Err.Number = 9 Then
    MsgBox "Can't find the workbook"
Else
    MsgBox Err.Description
End If

End Sub

You're amazing - thanks so much for all your help!! It works perfectly!

 

[Akuini]

Glad it works.