Hello,

The following is a code I've made with help of several people and using the
record macro function in Excel. It does everything I want it to do, BUT save
and share. I've tried different things but nothing seems to work.

So I need help on how to get my file to when it's done with what it is
doing, save the worksheet, and share it. So far when I run it, it gets down
to the save part and a box will pop up saying are you sure you want to save
because there is a file with that name already. I click yes, it "saves". Then
I'll close it and open it back up and it's no longer shared and no changes
have been saved.

SOMEONE HELP ME PLEASE!!!

Sub Update()
Dim nResult As Long
nResult = MsgBox(Prompt:="Are you sure you want to update the Bank Rec
Tracker?" & vbNewLine & "Are you sure no one else is making changes in the
tracker?", _
Buttons:=vbYesNo)
If nResult = vbNo Then
MsgBox "You cancelled the update."
Else


Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.ExclusiveAccess
Application.DisplayAlerts = True
Dim res As Variant
Dim fName As Variant
Dim TempWkbk As Workbook
Dim TrackWkbk As Workbook
Dim AcctWks As Worksheet
Dim myCell As Range
Dim myRng As Range
Dim DestCell As Range


Set TrackWkbk = ActiveWorkbook

fName = Application.GetOpenFilename()
If fName = False Then

Exit Sub
End If

Set TempWkbk = Workbooks.Open(Filename:=fName, ReadOnly:=True)

TempWkbk.Worksheets("Accounting_Teams").Copy _
Befo=TrackWkbk.Sheets(1)

Set AcctWks = TrackWkbk.Sheets(1) 'the newly pasted sheet

TempWkbk.Close savechanges:=False

X = 4

Do While Cells(X, Y).Value < ""
Sheets("Bank Rec Tracker").Select
z = Application.WorksheetFunction.Match(Cells(X, 2),
Sheets("Accounting_Teams").Columns("C:C"), 0)
Sheets("Accounting_Teams").Select
Cells(z, 20).Select
Selection.Copy
Sheets("Bank Rec Tracker").Select
Cells(X, 14).Select
ActiveSheet.Paste
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With


X = X + 1
Loop
Sheets("Accounting_Teams").Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
With ActiveWorkbook
.KeepChangeHistory = True
.ChangeHistoryDuration = 30
End With
ActiveWorkbook.SaveAs AccessMode:=xlShared

Application.ScreenUpdating = True
MsgBox ("Update complete!")
End If

End Sub

I just found out, the file is saving as shared in the last directory that I
used. Earlier in the code I tell it to open a file, and I'm able to select
where the file is. Using this saveas method saves my file in the Opened
file's directory. Is there a way to get around this without specifiying the
file's name? I can give the full directory path, but the file name is always
changing due to the day.

"GTyson2" wrote:

Hello,

The following is a code I've made with help of several people and using the
record macro function in Excel. It does everything I want it to do, BUT save
and share. I've tried different things but nothing seems to work.

So I need help on how to get my file to when it's done with what it is
doing, save the worksheet, and share it. So far when I run it, it gets down
to the save part and a box will pop up saying are you sure you want to save
because there is a file with that name already. I click yes, it "saves". Then
I'll close it and open it back up and it's no longer shared and no changes
have been saved.

SOMEONE HELP ME PLEASE!!!

Sub Update()
Dim nResult As Long
nResult = MsgBox(Prompt:="Are you sure you want to update the Bank Rec
Tracker?" & vbNewLine & "Are you sure no one else is making changes in the
tracker?", _
Buttons:=vbYesNo)
If nResult = vbNo Then
MsgBox "You cancelled the update."
Else


Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.ExclusiveAccess
Application.DisplayAlerts = True
Dim res As Variant
Dim fName As Variant
Dim TempWkbk As Workbook
Dim TrackWkbk As Workbook
Dim AcctWks As Worksheet
Dim myCell As Range
Dim myRng As Range
Dim DestCell As Range


Set TrackWkbk = ActiveWorkbook

fName = Application.GetOpenFilename()
If fName = False Then

Exit Sub
End If

Set TempWkbk = Workbooks.Open(Filename:=fName, ReadOnly:=True)

TempWkbk.Worksheets("Accounting_Teams").Copy _
Befo=TrackWkbk.Sheets(1)

Set AcctWks = TrackWkbk.Sheets(1) 'the newly pasted sheet

TempWkbk.Close savechanges:=False

X = 4

Do While Cells(X, Y).Value < ""
Sheets("Bank Rec Tracker").Select
z = Application.WorksheetFunction.Match(Cells(X, 2),
Sheets("Accounting_Teams").Columns("C:C"), 0)
Sheets("Accounting_Teams").Select
Cells(z, 20).Select
Selection.Copy
Sheets("Bank Rec Tracker").Select
Cells(X, 14).Select
ActiveSheet.Paste
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With


X = X + 1
Loop
Sheets("Accounting_Teams").Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
With ActiveWorkbook
.KeepChangeHistory = True
.ChangeHistoryDuration = 30
End With
ActiveWorkbook.SaveAs AccessMode:=xlShared

Application.ScreenUpdating = True
MsgBox ("Update complete!")
End If

End Sub