Search thru sheets to match cell contents then pick up data Phew!

[Annie Whitley]

Hi,

I'm sincerely hoping this is possible and doable but not that optimistic

I have data in one workbook (Info) that needs to fill into data in another
workbook (Reports) i.e. the data fills in the gaps. There is one sheet per
Employee in each of the Workbooks. INFO has unique employee Reference number
(URN) in L30 as last 4 values in a text string. Reports has URN as value in
N1.

The Info workbook has been produced by another department and the way the
data has been laid out it would take a lot of cleaning up to make it usable
(merged fields etc).

What I would love to be able to do is pick up URN from N1 in the first sheet
of Reports then loop through the sheets in Info to match UPN to a cell in the
corresponding sheet. NB UPN is part of string in Info.

Then I would like to pick up values and colour format (shading) from range
B41:C45(INFO) and paste into range C1923 (Reports). The next range to copy
is E41:E45 but this is a merged range E:F. Then paste to E19:E23.

Then move onto sheet 2 in reports and do the same again etc etc.

There are nearly 100 sheets in each wkbk.

What do you think?

I also have to say that I'm just a dabbler in VBA. I mostly adapt stuff I've
found here and on other forums. Totally understand if I'm expecting too much!

Thank you

 

[joel]

for womebody who has done some VBA programming this is not too
difficult. the code would run quicker if you gave me more details where
the UPN number is located in the info sheet. I'm searching in the code
belwo the entire worksheet for the number which is extremely slow
method. The code would run much quicker if I knew exactly where to
search for the UPN.



Sub MergeData()

'Put this macro into workbooks report
Set Rptbk = ThisWorkbook
Set Infobk = Workbooks("Info.xls")

For Each RptSht In Rptbk.Sheets
With RptSht
UPN = .Range("N1")
For Each InfoSht In Infobk.Sheets
'find dUPN
With InfoSht
Set c = .Cells.Find(What:=UPN, _
LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
Range("B41:C45").Copy _
Destination:=RptSht.Range("C1923")
RptSht.Range("E19") = .Range("E41")
RptSht.Range("E20") = .Range("E42")
RptSht.Range("E21") = .Range("E43")
RptSht.Range("E22") = .Range("E44")
RptSht.Range("E23") = .Range("E45")
Exit For
End If
End With
Next InfoSht
End With
Next RptSht


End Sub

 

[Matthew Herbert]

Annie,

If you are a "dabbler" then I'll give you some code snipets that you should
be able to piece together. Some parts of your explanation are a bit hard to
follow, but hopefully the code will steer you in the right direction. (As
you know, you'll have to qualify the ranges correctly, i.e. point to the
right workbooks, worksheets, and ranges). Let me know if these are or are
not helpful, and/or if you need further assistance. Also, you can unmerge
cells very easily (i.e. Range.Unmerge).

Best,

Matthew Herbert

Dim wkbInfo As Workbook
Dim wkbRpt As Workbook
Dim strURN As String
Dim rngFound As Range
Dim rngCopy As Range
Dim rngPaste As Range
Dim Wks As Worksheet

Set wkbInfo = Workbooks(1)
Set wkbRpt = Workbooks(2)
strURN = Right(wkbRpt.Worksheets(1).Range("N1").Value, 4)

For Each Wks In wkbInfo.Worksheets
Set rngFound = Wks.Cells.Find(strURN)
If Not rngFound Is Nothing Then
MsgBox "Found '" & strURN & "' in the following location:" & vbLf & _
rngFound.Address(External:=True)
End If
Next Wks

For Each Wks In wkbRpt.Worksheets
Set rngCopy = Wks.Range("B41:C45")
Set rngPaste = wkbRpt.Worksheets(1).Range("C19")
rngCopy.Copy rngPaste
Next Wks

 

[Annie Whitley]

Hi Matthew,

Thanks for your reply

I'll have a dabble this evening