vba:ActiveWorkbook.CheckCompatibility = False not working

B

bamaisgreat

Well-known Member
Joined
Jan 23, 2012
Messages
821
Office Version
  1. 365
Platform
  1. Windows
For some reasone the dialog box keeps popping up to check the compatibility. I would have thought the red shaded line below would have took care of that. Any help appreciated.. Thanks as always
On Error Resume Next
Kill "H:\All\Material Prep Archive\(Public)Archive.xls"
Columns("A:H").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs Filename:= _
"H:\All\Material Prep Archive\(Public)Archive.xls" _
, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
You're saving the workbook twice.

ActiveWorkbook.SaveAs Filename:= _
"H:\All\Material Prep Archive\(Public)Archive.xls" _
, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.Save

Perhaps the compatibly dialog pops-up on the second save?
 
Upvote 0
Thanks for looking yes you are right I didn't notice that. Is there something I can put before the first save( I'm deleting the second one ) that will skip it if someone has the workbook open instead of it be bugging There is more code below this
 
Upvote 0
Are you asking to test if the workbook (Public)Archive.xls is already open before doing the SaveAs?

If yes...
Code: 
    [color=darkblue]Dim[/color] wb [color=darkblue]As[/color] Workbook
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
    [color=darkblue]Set[/color] wb = Application.Workbooks("(Public)Archive.xls")
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] 0
    
    [color=darkblue]If[/color] [color=darkblue]Not[/color] wb [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
        [color=green]'Workbook is alredy opened[/color]
    [color=darkblue]Else[/color]
        [color=green]'Workbook is not open[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
 
Last edited:
Upvote 0
ok, could you add that to this section of my code below ? Im uncertain where it goes since I have a kill command. Thanks


If Not ws1.Range("H" & I + 4).Value = "" Then
Sheets("Sheet1").Hyperlinks.Add Anchor:=Sheets("Sheet1").Range("H" & NR + I), Address:= _
HypoAddress, SubAddress:= _
HypoSubAddress, TextToDisplay:= _
"BURNEY 2 JOB"
End If

Next I
ActiveWorkbook.Save
With ActiveSheet
.Protect Password:="master"
End With
ActiveWorkbook.Save
On Error Resume Next
Kill "H:\All\Material Prep Archive\(Public)Archive.xls"
Columns("A:H").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.DisplayAlerts = False
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs Filename:= _
"H:\All\Material Prep Archive\(Public)Archive.xls" _
, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Click to expand...
 
Upvote 0
Maybe something like this. But I'm not sure what your intentions are.

Code: 
        [color=darkblue]If[/color] [color=darkblue]Not[/color] ws1.Range("H" & I + 4).Value = "" [color=darkblue]Then[/color]
            Sheets("Sheet1").Hyperlinks.Add Anchor:=Sheets("Sheet1").Range("H" & NR + I), Address:= _
            HypoAddress, SubAddress:= _
            HypoSubAddress, TextToDisplay:= _
            "BURNEY 2 JOB"
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] I
    ActiveSheet.Protect Password:="master"
    ActiveWorkbook.Save
    
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
    Application.Workbooks("(Public)Archive.xls").Close SaveChanges:=[color=darkblue]False[/color]
    Kill "H:\All\Material Prep Archive\(Public)Archive.xls"
    [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] 0
    
    Columns("A:H").Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.DisplayAlerts = [color=darkblue]False[/color]
    ActiveWorkbook.CheckCompatibility = [color=darkblue]False[/color]
    ActiveWorkbook.SaveAs Filename:= _
    "H:\All\Material Prep Archive\(Public)Archive.xls" _
    , FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Close
    Application.DisplayAlerts = [color=darkblue]True[/color]
    ActiveWorkbook.CheckCompatibility = [color=darkblue]True[/color]
 
Upvote 0
Thank you for the help. The Complete module I have Is really a mess but it works. My Idea is if the Public Archive.xls is open then the code will not update the sheet.

Sub FINALIZED_BY_QC_job()
Dim newFileName As String
Dim appendtext As String
Dim rngfil As Range, cell As Range
Dim NR As Long, I As Long
If UCase(InputBox("Enter Password")) <> "1288" Then Exit Sub
With ActiveSheet
.Unprotect Password:="1288"
With .Range("J24").Interior
.Pattern = xlSolid
.PatternColorIndex = 1
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
appendtext = " -FINAL"
.Range("J24").FormulaR1C1 = appendtext
With ActiveWorkbook
oldFileName = .FullName
newFileName = Left(.FullName, InStrRev(.FullName, ".xls") - 1) _
& appendtext
.SaveAs Filename:=newFileName
End With
Kill oldFileName
ActiveWorkbook.Save
Set ws1 = ActiveWorkbook.Sheets("JOB CUTTING FORM")
SourcePath = ActiveWorkbook.Path
SourceFile = Left(ActiveWorkbook.name, InStrRev(ActiveWorkbook.name, ".xls") - 1) & "-PA.xls"

ActiveSheet.Shapes.Range(Array("Button 192")).Select
Selection.OnAction = "PURCH_COMMENTS_JOB"
Range("$H$1:$K$1").Locked = True

Cells.Select
Selection.Locked = True
Range("W4:W22").Select
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.EnableSelection = xlUnlockedCells
Range("W4").Select

Set rngfil = Range("B4,C4,H4,J4,N4,T4,U4") 'first row of data to be processed
For r = 0 To 18 'row offset variable
EmptyRowCheck = ""
For Each cell In rngfil.Offset(r, 0) 'Concat values of cells in rngfil offset
EmptyRowCheck = EmptyRowCheck & cell
Next cell
If EmptyRowCheck = "" Then GoTo FoundEmptyRow ' if "" empty row of rngfil cells found so stop putting -
For Each cell In rngfil.Offset(r, 0) 'otherwise put - in any empty cell
If cell.Value = vbNullString Then
cell.Value = "-"
End If
Next cell
Next r
FoundEmptyRow: 'stop putting -
' Archive values to ....
Filename = "H:\Burney Table\CUTTING FORMS (Protected by QC)\Archive\Master Archive.xls"
Workbooks.Open (Filename)
With ActiveSheet
.Unprotect Password:=""
End With
HypoAddress = SourcePath & "\" & SourceFile
NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
For I = 0 To 18
Sheets("Sheet1").Range("A" & NR + I).Value = ws1.Range("B" & I + 4).Value
'Sheets("Sheet1").Range("B" & NR + I).Value = ws1.Range("B" & I + 4).Value
Sheets("Sheet1").Range("C" & NR + I).Value = ws1.Range("C" & I + 4).Value
Sheets("Sheet1").Range("D" & NR + I).Value = ws1.Range("H" & I + 4).Value
Sheets("Sheet1").Range("E" & NR + I).Value = ws1.Range("J" & I + 4).Value
Sheets("Sheet1").Range("F" & NR + I).Value = ws1.Range("N" & I + 4).Value
Sheets("Sheet1").Range("G" & NR + I).Value = ws1.Range("T" & I + 4).Value
Sheets("Sheet1").Range("H" & NR + I).Value = ws1.Range("U" & I + 4).Value
'////////////////////NEXT 2 LINES LOOKS IN THE COLUMN TO SEE IF INFO IS IN THERE
'////////////////////SO IT CAN ADD HYPERLINK
HypoSubAddress = "'" & ws1.name & "'" & "!" & ws1.Range("H" & I + 4).Address
If Not ws1.Range("H" & I + 4).Value = "" Then
Sheets("Sheet1").Hyperlinks.Add Anchor:=Sheets("Sheet1").Range("I" & NR + I), Address:= _
HypoAddress, SubAddress:= _
HypoSubAddress, TextToDisplay:= _
"BURNEY 2 JOB"
End If

Next I
ActiveWorkbook.Save
With ActiveSheet
.Protect Password:=""
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
.Protect Password:="1288", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
ThisWorkbook.Save
On Error Resume Next
Kill "H:\All\Material Prep Archive\(Public)Archive.xls"
On Error GoTo 0
On Error Resume Next
FileCopy Source:="H:\Burney Table\CUTTING FORMS (Protected by QC)\Archive\Master Archive.xls", Destination:= _
"H:\All\Material Prep Archive\(Public)Archive.xls"
Application.Quit
End Sub
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
VBA: Execute Macro from WB1, and email WB2
Replies
1
Views
341
sachavez
S
A
  • Question
Date modified
Replies
0
Views
657
Avalb
A
S
  • Question
Need help new to VBA, working with exporting to csv of course row 1 has more cells then other rows which causes trailing commas for rest of rows
Replies
3
Views
634
MoshiM
M
M
  • Question
Rename Workbook Name with Entered value
Replies
1
Views
498
Joe4
Joe4
S
  • Solved
Why does this macro work for my colleague but not me?
Replies
8
Views
3K
Silverjman
S

Forum statistics

Threads
1,215,316
Messages
6,124,228
Members
449,149
Latest member
mwdbActuary

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top