VBA Code to link spreadsheet data

[Tira]

I am in need of a code that will put the figures from the Do Not Pay speadsheet for each month in the corresponding month tabs in the Summary Sheets workbook. The tabs highlighted in the Do Not Pay spreadsheet are not listed in the correct order though.

Then I need the data to roll over in the Summary tab of the Summary Sheets workbook.

Do you think this is possible?

Thanks!

[mdmackillop]

It is possible but unreasonable to do so with the raw data as provided. For data to be processed, it has to be consistent. Your date information has varying formats; the layout differs between sheets; you have blank sheets and one full of 6Ô\'søÂÓñª’Ð (I quote).
The inconsistency in sheet order that you do note is not important.
Fix your data and repost the workbook.
From which book do you intend to run the code?

[Tira]

I have made all data consistent in the "Do Not Pay File Sample". I think the code will be ran from the "Summary Sheets".

I need the code to pull the information from the "Do Not Pay File Sample" and have it inputted into the "Summary Sheets" workbook by month and the Summary tab is okay. It will update automatically. *Note-each month, data is added to the "Do Not Pay File Sample" (from Oct. to Sept).


Thanks!

[mdmackillop]

Try this. The code uses column 10 of worksheets to clean up names.
I've included an optional hyperlink. It slows down execution but may be useful for checking purposes. Delete the lines if not required


Sub Test()

Dim DNP As Workbook, SSS As Workbook
Dim wss As Worksheet
Dim Juris As Range
Dim i&, k&
Set DNP = Workbooks("Do Not Pay File Sample.xlsm")
Set SSS = Workbooks("Summary Sheets Sample.xlsm")
Call GetInit(DNP)
Call GetInit(SSS)


For Each ws In DNP.Sheets
'ws.Activate
If ws.Cells(1, 1) <> "" Then
arr = ws.UsedRange
For i = 1 To UBound(arr)
If InStr(1, Trim(arr(i, 2)), "TOTAL") = 0 And Not (arr(i, 2) = Empty) Then
x = Split(Trim(arr(i, 2)), "-")
Set wst = SSS.Sheets(x(1) & " " & x(0))
If Not wst Is Nothing Then
Set Juris = wst.Columns(10).Find(arr(i, 10))
If Not Juris Is Nothing Then
'Application.Goto Juris
For k = 3 To 8
wst.Cells(Juris.Row, k - 1) = arr(i, k)

'Optional hyperlink
wst.Hyperlinks.Add Anchor:=Cells(Juris.Row, 1), _
Address:="DO%20NOT%20PAY%20FILE%20SAMPLE.xlsm", _
SubAddress:=ws.Name & "!A" & i
'End of Option
Next k
End If
End If
End If
Next i
End If
Next ws
Call CleanUp(DNP)
Call CleanUp(SSS)
MsgBox "Done"
End Sub


Sub GetInit(Bk)
Dim ws As Worksheet, r As Range
Dim tmp
On Error Resume Next
For Each ws In Bk.Sheets
Set r = ws.Columns(1).SpecialCells(2)
If Not r Is Nothing Then
For Each cel In r
tmp = cel.Offset(, 9)
tmp = Application.Substitute(cel, " ", "")
tmp = Application.Substitute(tmp, "-", "")
tmp = Application.Substitute(tmp, Chr(26), "")
cel.Offset(, 9) = tmp
Next cel
End If
Next ws
End Sub


Sub CleanUp(Bk)
Dim ws As Worksheet, r As Range
Dim tmp
On Error Resume Next
For Each ws In Bk.Sheets
ws.Columns(10).ClearContents
Next ws
End Sub

[mdmackillop]

Just noticed an issue. Because on sheet PTAJE (and similar) you have used only JE as the Jurisdiction, the code will return wrong values for PTBJE if JE is used again
This line
Set Juris = wst.Columns(10).Find(arr(i, 10))
should be changed to
Set Juris = wst.Columns(10).Find(arr(i, 10), Lookat:=xlWhole)
once data has been fixed.

[Tira]

Hi, I have both files open and when I attempt to run the VBA code, it will not work.
It keeps getting stuck at "Set SSS = Workbooks("Summary Sheets Sample.xlsm")". Do you know what the issue could be.

Thanks!

[mdmackillop]

Check the extension, I saved my copy as xlsm
Are both files open in the same instance of Excel?

[Tira]

Right!! I forgot about that. Problem solved! Thanks.

But the code only processed the "DME"s. How can I get it to process the rest of the tabs (i.e. PTJ15, etc.).

I think you mentioned about the naming conventions somewhat above but I need to know what to do to make it work.

Thank you so much!

[mdmackillop]

This line

If ws.Cells(1, 1) <> "" Then
omits any sheets where A1 is blank. If you fix your abbreviations to avoid duplicates and populate Column A from Row 1, the code should work.

[Tira]

I updated everything in column A, but the VBA code stops working for the "PTB" tabs towards the end. I need the name information to stay as is, so how do I get the code to complete all the tabs.

Here's where the code gets hung up at: "Set wst = SSS.Sheets(x(1) & " " & x(0))". I attached the updated Do Not Pay File with all A1 cells named.

Thanks!

[mdmackillop]

Remove the  character (Chr26) at the bottom of Column B or change this line as shown

If InStr(1, Trim(arr(i, 2)), "TOTAL") = 0 And Not (arr(i, 2) = Empty) And Not (arr(i, 2) = Chr(26)) Then

[Tira]

That was it!! Great, thank you so much!

[mdmackillop]

Happy to help; if this is solved, please mark it so using the Thread Tools dropdown