Close and Re-open workbook followed by SaveAs .prn

Question

I have been busy with creating a code for sorting a database in a new workbook. Sheet2 of this workbook needs to be saved next to the workbook as "Sheet2.prn". I managed to do this, but today I needed to add 2 columns to Sheet2 and now for some reason the last step of resaving the file as .prn doesn't work anymore. I really don't have a clue what I have done wrong as I'm pretty sure I didn't change anything to the last part of my code.

This is my code:

Option Explicit
Sub RowCount()                                                                                                                   
Dim Oldstatusbar As Boolean                                                                                                  
Dim DOF As Integer, Counter As Integer                                                                                       
Dim CurrentMin As Long, StartRow As Long, StartColumn As Long                                                                
Dim OutputColumn As Long, OutputRow As Long, InputValue As Long
Dim Borehole As String, Start_Row As String, End_Row As String, Output As String, FolderPath As String                       
Dim CurrentName As String
Dim rng As RANGE, Cell As RANGE, brh As RANGE, Undef1 As RANGE, Undef2 As RANGE                                              
Dim r1 As RANGE, r2 As RANGE, r3 As RANGE, r4 As RANGE, r5 As RANGE, r6 As RANGE, r7 As RANGE, r8 As RANGE, r9 As RANGE
Dim r10 As RANGE, r11 As RANGE, r12 As RANGE, r13 As RANGE
Dim wbMain As Workbook, wbWellsRowCount As Workbook                                                                          
Dim wsLog As Worksheet, wsSheet1 As Worksheet, wsSheet2 As Worksheet                                                         
Dim HCdatabase2 As Variant                                                                                                   

Oldstatusbar = Application.DisplayStatusBar                                                                                  



Set wbMain = Workbooks("HCdatabase2.xlsm")                                                                                   
Set wsLog = wbMain.Sheets("Log")                                                                                             
FolderPath = ThisWorkbook.Path                                                                                               

DOF = 1                                                                                                                      
Counter = 1                                                                                                                  

wsLog.Select                                                                                                                 
StartColumn = 1                                                                                                              
StartRow = 1                                                                                                                 
wsLog.Cells(StartRow + DOF, StartColumn).End(xlDown).Select                                                                  

Set rng = wsLog.RANGE(wsLog.Cells(StartRow + DOF, StartColumn), wsLog.Cells(StartRow + DOF, StartColumn).End(xlDown))        
CurrentName = wsLog.Cells(StartRow + DOF, StartColumn).Value                                                                 
CurrentMin = Cells(StartRow + DOF, StartColumn).Row                                                                          


Set wbWellsRowCount = Workbooks.Add                                                                                          
wbWellsRowCount.SaveAs FolderPath & "\wbWellsRowCount.xls"                                                                   


Set wsSheet1 = wbWellsRowCount.Sheets("Sheet1")                                                                              
wsSheet1.Select                                                                                                              
OutputColumn = 1                                                                                                             
OutputRow = DOF + 1                                                                                                          
wsSheet1.Cells(OutputRow, OutputColumn).Value = CurrentName                                                                  
wsSheet1.Cells(OutputRow, OutputColumn + 1).Value = CurrentMin                                                               

wsSheet1.Cells(1, 1).Name = "Borehole"                                                                                       
wsSheet1.Cells(1, 2).Name = "Start_Row"                                                                                      
wsSheet1.Cells(1, 3).Name = "End_Row"                                                                                        
wsSheet1.Cells(1, 4).Name = "Output"                                                                                         

ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)                                                                
Set wsSheet2 = wbWellsRowCount.Sheets("Sheet2")                                                                              



  Set r1 = Workbooks("HCdatabase2.xlsm").Worksheets("Log").RANGE("A:A")                                                            
  Set r2 = Workbooks("wbWellsRowCount.xls").Worksheets("Sheet2").RANGE("A:A")                                                      
  Set r3 = Workbooks("HCdatabase2.xlsm").Worksheets("Log").RANGE("J:J")                                                            
  Set r4 = Workbooks("wbWellsRowCount.xls").Worksheets("Sheet2").RANGE("B:B")                                                      
  Set r5 = Workbooks("HCdatabase2.xlsm").Worksheets("Log").RANGE("M:M")                                                            
  Set r6 = Workbooks("wbWellsRowCount.xls").Worksheets("Sheet2").RANGE("C:C")                                                      
  Set r7 = Workbooks("HCdatabase2.xlsm").Worksheets("Log").RANGE("AC:AC")                                                          
  Set r8 = Workbooks("wbWellsRowCount.xls").Worksheets("Sheet2").RANGE("D:D")                                                      
  Set r9 = Workbooks("HCdatabase2.xlsm").Worksheets("Log").RANGE("AF:AF")                                                          
  Set r10 = Workbooks("wbWellsRowCount.xls").Worksheets("Sheet2").RANGE("E:E")                                                     
  Set r11 = Workbooks("HCdatabase2.xlsm").Worksheets("Log").RANGE("D:D")                                                           
  Set r12 = Workbooks("wbWellsRowCount.xls").Worksheets("Sheet2").RANGE("F:F")                                                     
  Set r13 = Workbooks("wbWellsRowCount.xls").Worksheets("Sheet2").RANGE("G:G")                                                     

  r1.Copy    r2                                                                                                                       
  r3.Copy r4                                                                                                                       
  r5.Copy                                                                                                                          
  r6.PasteSpecial Paste:=xlPasteValues                                                                                             
  r7.Copy r8                                                                                                                       
  r9.Copy                                                                                                                          
 r10.PasteSpecial Paste:=xlPasteValues                                                                                            
 r11.Copy r12
 r11.Copy r13
 Application.CutCopyMode =   False                                                                                                  



 With wbWellsRowCount.Sheets("Sheet2")                                                                                            
    With .RANGE("A2", .Cells(.Rows.Count, 1).End(xlUp))                                                                      
        .Offset(.Rows.Count).Value = .Value                                                                                  
        .Offset(.Rows.Count, 1).Value = .Offset(, 3).Value                                                                   
        .Offset(.Rows.Count, 4).Value = .Offset(, 4).Value                                                                   
        .Offset(.Rows.Count, 5).Value = .Offset(, 5).Value                                                                   
        .Offset(.Rows.Count, 6).Value = .Offset(, 6).Value                                                                   

        .Offset(, 4).ClearContents                                                                                           
        .Offset(, 3).EntireColumn.Delete                                                                                     

        With .Offset(, 1).Resize(2 * .Rows.Count)                                                                            
            If WorksheetFunction.CountBlank(.Cells) > 0 Then .SpecialCells(XlCellType.xlCellTypeBlanks).EntireRow.Delete     
        End With
    End With

    With .RANGE("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 7)                                                         
        .Sort key1:=.Cells(1, 1), order1:=xlAscending, key2:=.Cells(1, 2), order2:=xlAscending, Header:=xlNo, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal 
    End With
End With



 Set Undef1 = Workbooks("wbWellsRowCount.xls").Worksheets("Sheet2").UsedRange                                                     

 On Error Resume   Next                                                                                                             

 InputValue = -999                                                                                                                
 For Each Cell In Undef1                                                                                                          
If IsEmpty(Cell) Then                                                                                                            
 Cell.Value = InputValue                                                                                                          
 End If                                                                                                                           
 Next                                                                                                                             



 On Error Resume     Next                                                                                                              

For Each Cell In r12                                                                                                             
If (Cell) Then                                                                                                                   
Cell.Value = Left(Cell.Value, 2)                                                                                                 
End If                                                                                                                           
Next                                                                                                                             

Columns("A:F").HorizontalAlignment = xlRight                                                                                     
Columns("A:F").AutoFit                                                                                                           
 Columns("E").ColumnWidth = 9                                                                                                     



 For Each Cell In rng                                                                                                             

If Cell.Value <> CurrentName Then                                                                                             

    wsSheet1.Cells(OutputRow, OutputColumn + 2).Value = Cell.Row - 1                                                         
    CurrentName = Cell.Value                                                                                                 
    CurrentMin = Cell.Row                                                                                                    
    OutputRow = OutputRow + 1                                                                                                
    wsSheet1.Cells(OutputRow, OutputColumn).Value = CurrentName                                                              
    wsSheet1.Cells(OutputRow, OutputColumn + 1).Value = CurrentMin                                                           

    wsSheet1.Cells(Counter + DOF, "D").Value = Counter                                                                       
    Counter = Counter + 1                                                                                                    
End If                                                                                                                       

 Next Cell                                                                                                                   
 Set Cell = rng.End(xlDown)                                                                                                  
 wsSheet1.Cells(OutputRow, OutputColumn + 2).Value = Cell.Row                                                                
 wsSheet1.Cells(Counter + DOF, "D").Value = Counter                                                                          


wbWellsRowCount.Close True                                                                                                   
wbWellsRowCount.Open
'wbWellsRowCount.Open FolderPath & "\wbWellsRowCount.xls"                                                                    
wbWellsRowCount.Worksheets("Sheet2").SaveAs Filename:="HCShowDatabase.prn", FileFormat:=xlTextPrinter                        
Workbooks("HCShowDatabase.prn").Close True                                                                                   
wbMain.Activate                                                                                                              
RANGE("A1").Select                                                                                                           
ActiveWindow.ScrollRow = RANGE("A1").Row                                                                                     

Application.ScreenUpdating = True                                                                                            
Application.DisplayStatusBar = Oldstatusbar                                                                                  
End Sub                                                                                                                          

I tried both 2nd (worked fine before) and 3rd rule, but for some reason the file doesn't re-open. To be specific, I want the workbook "wbWellsRowCount" to be saved and then re-opened so that I can SaveAs as Space delimited text file.

Can anyone help me with this?

Answer 1

Because the workbook is already open . It doesn't make any sense to close it and re-open it, doing so is expensive/time-consuming and serves no real purpose that I can see.

Also, you can't do it this way, because once you do the .Close True , the object is no longer available for you to use the .Open method, and were it not for your On Error Resume Next , this line would definitely raise an error (91: Object Variable Or With Block Not Set).

Get rid of:

wbWellsRowCount.Close True   '### DELETE THIS LINE                                                                                        
wbWellsRowCount.Open         '### DELETE THIS LINE

So that you're left with just this:

wbWellsRowCount.Worksheets("Sheet2").SaveAs Filename:="HCShowDatabase.prn", FileFormat:=xlTextPrinter                        
Workbooks("HCShowDatabase.prn").Close True