asked on

VBA copy data to destination workbook

Hello Experts,
I have some code I need to modify, but when I add my entries it does not play well and throws the copying of cell values incorrectly.

I need to add code that will copy the value of source workbook ("A3") to destination workbook (Column A) while looping through each worksheet. However the value in ('A3") contains a "#" symbol preceding the value and I want to capture only the remaining Left 3 characters as the value to copy to the destination workbook.
(or copy the ws.name which is the 3 digit character I am seeking to use)

I am posting my code below:

Private Sub GetInfo()

Dim j, k, colOffset As Integer
Dim i As Long, labelRow As Long
Dim siteNo, ref, colName, wrkbook As String
Dim header, target As Range
Dim Sourcewb As Workbook

For i = 1 To Application.Workbooks.Count
If Workbooks(i).Name Like "CRG OPERATING PARTNER*" Then
Set Sourcewb = Workbooks(i)
Exit For
End If
Next i

If Sourcewb Is Nothing Then
Beep
MsgBox "CRG OPERATING PARTNER P&L 3) FINAL" & vbCr & " EXCEL FILE IS NOT OPEN!"
Set Sourcewb = Nothing
Exit Sub
End If

wrkbook = "[" & CStr(Sourcewb.Name) & "]"

KEYDATA.Unprotect
Application.EnableEvents = False

Range("N3:AD13").ClearContents

k = 1

Set header = Range("N1")

While header.Cells(1, k).Value <> ""

colName = Evaluate("=IFERROR(VLOOKUP(" & header.Cells(1, k).Address & ",DATA!$B$1:$C$21,2,FALSE),"""")")
colOffset = Evaluate("=IFERROR(VLOOKUP(" & header.Cells(1, k).Address & ",DATA!$B$1:$E$21,4,FALSE),0)")

If (colName <> "") Then
j = 1
Do
siteNo = Right("000" & Range("A3").Cells(j, 1).Value, 3)
labelRow = Evaluate("=IFERROR(MATCH(""" & colName & """,'" & wrkbook & siteNo & "'!$K$9:$K$99,0),0)")
If (labelRow <> 0) Then
Range("N3").Cells(j, k).Value = Evaluate("='" & wrkbook & "" & siteNo & "'!" & Range("K9").Cells(labelRow, colOffset).Address)
End If
j = j + 1
Loop While Range("A3").Cells(j, 1).Value <> ""
End If

k = k + 1

Wend

Set target = Range("R3:R13")

For Each c In target.Cells
c.Value = -c.Value
c.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* "" - ""??_);_(@_)"
Next c

Range("N3:Q13").NumberFormat = "0.00%"

Application.EnableEvents = True

KEYDATA.Protect

Set target = Nothing

End Sub

Roy Cox

What error message are you getting?

Probably not causing any error but your variables are declared wrongly. For example

 Dim j, k, colOffset As Integer

Open in new window

In the above line Iyou leave out the type so VBA automatically sets the type to be a Variant. When you declare multiple variables you should specify the type of each one individually.

Dim j as Integer, k as Integer, colOffset As Integer

Open in new window

You don't actually specify which workbook the code should be working on. Are you sure it is working on the correct workbook? It will be working on the active workbook if you don't specify the workbook in the code.

What and where is Keydata?

You don't need to loop to set the number format.

Set target = Range("R3:R13")
    target.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* "" - ""??_);_(@_)"
    Range("N3:Q13").NumberFormat = "0.00%"

Open in new window

mike637

ASKER

Hello Expert Roy,

The code is it's original format and works fine. I was trying to add code - but without success, so I removed it and turned to Expert Exchange.
I will attach my workbooks. My routine is in the workbook 'OP Business Review' (Module 2) and it is pulling information from an Income statement, in this case it is 'CRG Operating Partner....' Many folks use the same 'OP Business Review' but each has their own income statement that are named differently except the 'CRG Operating Partner' will always remain the same.

What I would like to do is have 'A3' to 'A13' populate based on the sheet.name or cell.value in each worksheet 'A3' if truncated.
Then have 'C3' to 'C13' populate based on the cell.value 'A9' in each worksheet.

I hope this better clarifies what I would like to add to my existing code.
Thank you,
Michael
OP-Business-Review_2019---Copy.xlsm
CRG-OPERATING-PARTNER-800-P-L-FINAL.xlsx

ASKER CERTIFIED SOLUTION

mike637

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial