Attempting to update a macro.

[TheyCallMeIke]

Hi everyone,

I'm working on a Tool at work that contains a macro, whom was coded by somebody no longer with us. I have been tasked to update this, but have run into a problem.

What this macro does is, one after the next, it opens about 15 different excel spreadsheets, and cut/pastes all the information in the current worksheet from all of those .xls files.

the problem lies in that, (and i'll specify now before i paste the formula) it used to pull from this directory:

G:\ROC-CLAIMS\Clms Proc-Model Line\Adjustment Tracking Data (Statewide)\POS\POS Adjuster Tracking Log\variableuser\ .xls file

(now \variableuser is listed on the master spreadsheet in a tab that contains all the names, this is coded in the macro.)

now it used to work fine, but now that we've changed the directory where these .XLS files are located, it will open the files but not continue from there.

The new directory where these files are located is:

G:\ROC-CLAIMS\Clms Proc-Model Line\Adjustment Tracking Data (Statewide)\Adjuster Tracking Log\variableuser\ .xls file

so the POS subfolder has been removed as well as the POS phrease from the tracking log folder.

Here is the coding, loaded in 3 modules

"BookConstants" module

Option Explicit
'Constant Names used in procedurs
Public Const MainPath As String = "G:\ROC-CLAIMS\Clms Proc-Model Line\Adjustment Tracking Data (Statewide)"
Public Const Dep As String = "POS"
Public Const TrackingFolder As String = Dep & " Adjuster Tracking Log"
Public Const TrackingFile As String = TrackingFolder & ".xls"
Public Const MasterFolder As String = Dep & " Adjustment Master Tracking Log"
Public Const MasterName As String = MasterFolder & ".xls"

Public Const consErrMsg As String = "An error has been received. If the problem persists," & _
" please report the below information to emailhere@email.org: "

"LoadBooks" module

Public Function OpenBook(File As String) As Boolean
On Error GoTo OpenError
Workbooks.Open File, UpdateLinks:=0
OpenBook = True
Exit Function
OpenError:
OpenBook = False
End Function

"Pull Data" module

Public Sub GetData()
Dim FilePath, FileName As String
Dim TrackLastRow As String, MLastRow As String
Dim Mnth As String
Dim Rng As Range
Dim CopyRng As Range
Dim MLog As Workbook, Track As Workbook
Set MLog = ThisWorkbook
Set Rng = MLog.Sheets("Maint.").Range("StaffList")
Mnth = MLog.ActiveSheet.Name
Application.ScreenUpdating = False

'for each staff name in the Range, copy the tracking log
For Each cell In Rng

'get path for tracking log
FilePath = MainPath & "\" & Dep & "\" & TrackingFolder & "\" & cell.Value
FileName = FilePath & "\" & TrackingFile

'try to open the log. If it fails, alert user and offer to skip it.
If OpenBook(FileName) = False Then
If MsgBox("Unable to open the Tracking Log for " & cell.Value & _
". Would you like to move to the next staff member?", vbYesNo) = vbNo Then
Exit Sub
Else
GoTo TryNext
End If
End If

'select the opened tracking book
For Each Book In Workbooks
If Left(Book.Name, 12) = Dep & " Adjuster" Then
Set Track = Book
GoTo FoundIt:
Else
Set Track = Nothing
End If

Next Book
FoundIt:

'make sure the tacking book was found and selected
If Track Is Nothing Then
MsgBox consErrMsg
Exit Sub
End If

'activate the tab for the indicated month
Track.Sheets(Mnth).Activate

'find the last used row in the indicated month tab
TrackLastRow = ActiveSheet.Range("B65536").End(xlUp).Row

'first row of user-entered data is row 3. Don't copy anything above row 3.
If TrackLastRow < 3 Then
TrackLastRow = 3
End If

'set used range for copying
Set CopyRng = ActiveSheet.Range("A3:O" & TrackLastRow)
MLastRow = MLog.Sheets(Mnth).Range("B65536").End(xlUp).Row + 1
If MLastRow < 3 Then
MLastRow = 3
End If

'copy data from individual tracking book into master log
CopyRng.Copy
MLog.Sheets(Mnth).Range("A" & MLastRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Track.Sheets(Mnth).Activate

'remove copied data from individual tracking book
Application.DisplayAlerts = False
Track.Sheets(Mnth).Range("A3:O" & TrackLastRow).Delete
Application.DisplayAlerts = True
Track.Close True
TryNext:
Next cell
Application.ScreenUpdating = True
End Sub

Now what I thought I could do, was remove the Public Const as String Dep line, as well as all the "Dep" parts from all the modules, and it would work, but it doesn't. It does attempt to open the .xls files but stops at the first one and gives the error message as scripted to do so in the BookConstants module.

Can anyone figure out what I need to change to get this working appropriately?

Thanks in advance for taking the time to read and try to help me.

 

[TheyCallMeIke]

I'm sorry I forgot to post what I changed it to.

Now it looks like this

Option Explicit

'Constant Names used in procedures
Public Const MainPath As String = "G:\ROC-CLAIMS\Clms Proc-Model Line\Adjustment Tracking Data (Statewide)"
Public Const TrackingFolder As String = "Adjuster Tracking Log"
Public Const TrackingFile As String = TrackingFolder & ".xls"
Public Const MasterFolder As String = "Adjustment Master Tracking Log"
Public Const MasterName As String = MasterFolder & ".xls"
Public Const consErrMsg As String = "An error has been received. If the problem persists," & _
" please report the below information to emailhere@email.org: "

Public Function OpenBook(File As String) As Boolean
On Error GoTo OpenError
Workbooks.Open File, UpdateLinks:=0
OpenBook = True
Exit Function
OpenError:
OpenBook = False
End Function

Public Sub GetData()

Dim FilePath, FileName As String
Dim TrackLastRow As String, MLastRow As String
Dim Mnth As String
Dim Rng As Range
Dim CopyRng As Range
Dim MLog As Workbook, Track As Workbook
Set MLog = ThisWorkbook
Set Rng = MLog.Sheets("Maint.").Range("StaffList")
Mnth = MLog.ActiveSheet.Name
Application.ScreenUpdating = False

'for each staff name in the Range, copy the tracking log
For Each cell In Rng

'get path for tracking log
FilePath = MainPath & "\" & TrackingFolder & "\" & cell.Value
FileName = FilePath & "\" & TrackingFile

'try to open the log. If it fails, alert user and offer to skip it.
If OpenBook(FileName) = False Then
If MsgBox("Unable to open the Tracking Log for " & cell.Value & _
". Would you like to move to the next staff member?", vbYesNo) = vbNo Then
Exit Sub
Else
GoTo TryNext
End If
End If

'select the opened tracking book
For Each Book In Workbooks
If Left(Book.Name, 12) = "Adjuster" Then
Set Track = Book
GoTo FoundIt:
Else
Set Track = Nothing
End If

Next Book
FoundIt:

'make sure the tacking book was found and selected
If Track Is Nothing Then
MsgBox consErrMsg
Exit Sub
End If

'activate the tab for the indicated month
Track.Sheets(Mnth).Activate

'find the last used row in the indicated month tab
TrackLastRow = ActiveSheet.Range("B65536").End(xlUp).Row

'first row of user-entered data is row 3. Don't copy anything above row 3.
If TrackLastRow < 3 Then
TrackLastRow = 3
End If

'set used range for copying
Set CopyRng = ActiveSheet.Range("A3:O" & TrackLastRow)
MLastRow = MLog.Sheets(Mnth).Range("B65536").End(xlUp).Row + 1
If MLastRow < 3 Then
MLastRow = 3
End If

'copy data from individual tracking book into master log
CopyRng.Copy
MLog.Sheets(Mnth).Range("A" & MLastRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Track.Sheets(Mnth).Activate

'remove copied data from individual tracking book
Application.DisplayAlerts = False
Track.Sheets(Mnth).Range("A3:O" & TrackLastRow).Delete
Application.DisplayAlerts = True
Track.Close True
TryNext:
Next cell
Application.ScreenUpdating = True
End Sub

 

[jmthompson]

It looks like you made the correct updates to open the file, have any changes been made to the Stafflist? Does the value in the first cell match the corresponding folder in your Adjuster Tracking Log folder?

 

[TheyCallMeIke]

The StaffList has not changed, and is located in the 'Maint.' tab on the master tracking log in Column A; Cells 2-16.

The pathways are set correctly because it begins to open the first file, but once open it does not copy paste and just leaves the log open, then prompting the error message it should per the Option Explicit module.

All that was changed were the pathways where the spreadsheets were being pulled so I'm so confused as to why it's stuck now.

 

[TheyCallMeIke]

Still struggling with this, if anyone can think of why it's stopping between opening the .xls file and transferring the data, please comment

 

[jmthompson]

Try changing

If Left(Book.Name, 12) = "Adjuster" Then

to

If Left(Book.Name, 8) = "Adjuster" Then

 

[TheyCallMeIke]

Try changing

If Left(Book.Name, 12) = "Adjuster" Then

to

If Left(Book.Name, 8) = "Adjuster" Then

Jen you are amazing!! This was the fix. I didn't even notice it until you pointed that out because it used to be "POS Adjuster" so yeah removing the POS it would have to cut from 12 to 8.

I wish there was rep or something I could give.

 

[jmthompson]

happy to help