G
GTyson2
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 _
Before:=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
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 _
Before:=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