Issues with the last part of this code

eriklyon

New Member
Joined
Mar 9, 2016
Messages
15
Code:
'this works
Sub RUN_THIS_COPY_AND_MOVE_FILES()
'copy all Excel files from FromPath to ToPath.
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String

    FromPath = "E:\cheyney\latest\UNEDITED DATA\"  '<< Change
    ToPath = "E:\cheyney\latest\EDITED DATA\"    '<< Change

    FileExt = "*.txt*"  '<< Change
    'You can use *.* for all files or *.doc for Word files

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
    
   Call Removes_TXT_header
End Sub

'this works
Sub Removes_TXT_header()
    
    Dim strPath As String
    Dim strFile As String
    Dim FF As Long
    Dim i As Long
    Dim strText As String
    Dim vLines As Variant
    Dim Counter As Long
        
    'set path acordingly
    strPath = "E:\cheyney\latest\EDITED DATA\"
    strFile = Dir(strPath & "*.txt")
    FF = FreeFile
    
    Do Until strFile = ""
        
        'Read text file
        Open strPath & strFile For Input As #FF
        strText = Input$(LOF(FF), FF)
        Close #FF
        
        'Parse text (exclude first 6 lines)
        vLines = Split(strText, vbLf)
        If UBound(vLines) > 6 Then
            strText = vLines(7)
            For i = 8 To UBound(vLines)
                strText = strText & vbLf & vLines(i)
            Next
        
            'Write parsed text to file
            Open strPath & strFile For Output As #FF
            Print #FF, strText
            Close #FF
            
            Counter = Counter + 1
        End If
                
        strFile = Dir
    Loop
    
        
    Call Create_31_Sheets
End Sub


'create 31 sheets
'this works
Sub Create_31_Sheets()
Application.ScreenUpdating = False
'Add and Name sheets 4 - 31
  For sht = 4 To 31
     Sheets.Add After:=Sheets(Sheets.Count)
          
     Next
     Call freze_panes
    End Sub
    
  'this works
 'FREEZE PANES ALL SHEETS and format cells
 Sub freze_panes()
 Application.ScreenUpdating = False
    Dim newsheet
Dim strDate As String
Dim NumDays As Long
Dim i As Long
Dim Sh As Object
Dim wsBase As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        ws.Activate
        With ActiveWindow
            .SplitColumn = 0: .SplitRow = 4
            .FreezePanes = True
            End With
           Next
            Call Load_data
            End Sub
       
       Sub Load_data()
    Dim idx As Integer
    Dim fpath As String
    Dim fname As String
Application.ScreenUpdating = False
    idx = 0
    fpath = "E:\cheyney\latest\EDITED DATA\"
    fname = Dir(fpath & "*.txt")
    While (Len(fname) > 0)
        idx = idx + 1
        Sheets("Sheet" & idx).Select
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
          & fpath & fname, Destination:=Range("A5"))
            .Name = "a" & idx
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = True
            .TextFileColumnDataTypes = Array(1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
            fname = Dir
        Columns("A:G").Select
    Selection.ColumnWidth = 16.01
        
        End With
        
    Wend
    Call RemoveEmptySheets
    
End Sub
       
       
       
Sub RemoveEmptySheets()
    Dim shtTemp As Worksheet
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each shtTemp In ActiveWorkbook.Worksheets
        If shtTemp.Range("A5") = "" Then
            shtTemp.Delete
        End If
    Next
    
    Call Delete_CALIB_AND_BLOWBACK_Data
End Sub
       
       
Sub Delete_CALIB_AND_BLOWBACK_Data()

Application.ScreenUpdating = False

Dim ws As Worksheet
Dim l As Long
Dim lR As Long
Dim i As Long
MsgBox ("YOU ARE ABOUT TO REMOVE BLOWBACK AND CALIBRATION ROWS!!!!! THIS WILL TAKE A COUPLE MINUTES.")

For Each ws In Worksheets
    ws.Select
    
lR = ws.Range("E" & Rows.Count).End(xlUp).Row
     For i = lR To 1 Step -1
    If ws.Range("E" & i) > 0 Then
    ws.Range("E" & i).EntireRow.Delete
    End If
    Next i
       
   
 l = ws.Range("F" & Rows.Count).End(xlUp).Row
     For i = l To 1 Step -1
    If ws.Range("F" & i) > 0 Then
    ws.Range("F" & i).EntireRow.Delete


        End If
Next i
Next ws

Sheets(1).Activate
Range("A2").Select
Application.ScreenUpdating = True
Application.CutCopyMode = False

Call SelectSheets1

End Sub
       
    'this works select all sheets
      Sub SelectSheets1()
    Dim mySheet As Object
    For Each mySheet In Sheets
        With mySheet
            If .Visible = True Then .Select Replace:=False
        End With
    Next mySheet
    Call format_cells
End Sub
       
       
'this works
   Sub format_cells()
   Application.DisplayAlerts = False
            Columns("D:D").Select
    Selection.NumberFormat = "0.00"
    Range("C:C,G:G").Select
    Range("G1").Activate
    Selection.NumberFormat = "0"
    
    Cells.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
       Range("A2").Select
       ActiveCell.FormulaR1C1 = "=AVERAGE(C[2])"
       
       Range("A1:A2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
       Range("A1").Select
    ActiveCell.FormulaR1C1 = "AVERAGE"
    
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "CO"
       
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "O2"
    
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "BLOWBACK"
    
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "CALIB"
            
      Range("G4").Select
    ActiveCell.FormulaR1C1 = "FLOW"
    
    Range("B1").Select
    
    Selection.NumberFormat = "ddd mmm dd"
     ActiveWorkbook.Worksheets(1).Activate
     Range("A5").Select
     Sheets("Sheet1").Select
     Application.DisplayAlerts = True
     
           End With
           
        End With

    
   Call RenameSheets
   
End Sub
       
Sub RenameSheets()
For i = 1 To Sheets.Count
If Worksheets(i).Range("B1").Value <> "" Then
Sheets(i).Name = Worksheets(i).Range("B1").Value
End If
Next
End Sub

Having issues with renaming all sheets with cell value in this code, Any ideas? I am new at this, so that is why I am sure it looks sloppy to most.
 

Some videos you may like

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,388
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
What exactly are the "issues" you are having? Do you get an error? If so, what's the error message and which line of code is highlighted when you get it?
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,916
Office Version
  1. 365
Platform
  1. Windows
What issues are you having exactly? If you are getting errors, let us know what they say.
Note that you cannot name two sheets the same, or if you have an error in any of the B1 cells, that will cause problems too.
 

eriklyon

New Member
Joined
Mar 9, 2016
Messages
15
Code:
Sub RenameSheets()
For Each ws In Worksheets
    ws.Name = ws.Range("B1").Value
Next ws
End Sub

ws.Name = ws.Range("B1").Value this is what is highlighted when debugging

B1 = A5, then I reformat B1 with the code below

Code:
Range("B1").Select
    ActiveCell.FormulaR1C1 = "=R[4]C[-1]"
    Selection.NumberFormat = "ddd mmm dd"

it seems that there is an illegal name I am trying to name the sheet, but it is not as far as in can tell.
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,916
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Are you sure you are duplicating an existing name?
You could add this line of code to see exactly what it is trying to name each one:
Code:
Sub RenameSheets()
For Each ws In Worksheets
    MsgBox [FONT=Verdana]ws.Range("B1").Value[/FONT]
    ws.Name = ws.Range("B1").Value
Next ws
End Sub
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,388
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Code:
Sub RenameSheets()
For Each ws In Worksheets
    [B][COLOR=#ff0000]ws.Name = ws.Range("B1").Value[/COLOR][/B]
Next ws
End Sub

ws.Name = ws.Range("B1").Value this is what is highlighted when debugging

B1 = A5, then I reformat B1 with the code below

Code:
Range("B1").Select
    ActiveCell.FormulaR1C1 = "=R[4]C[-1]"
    Selection.NumberFormat = "ddd mmm dd"

it seems that there is an illegal name I am trying to name the sheet, but it is not as far as in can tell.
Do you have any errors in the B1 cells across all sheets? Or do you have illegal characters (like "/") in any of the B1 cells?
 
Last edited:

eriklyon

New Member
Joined
Mar 9, 2016
Messages
15

ADVERTISEMENT

when I run the code to rename all sheets in anther workbook, it does cycle through all sheets and name them properly, but I can not find out why it will not with this workbook, could it be because somehow this code is causing it not to work

Code:
Range("B1").Select
    
    Selection.NumberFormat = "ddd mmm dd"
     ActiveWorkbook.Worksheets(1).Activate
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,916
Office Version
  1. 365
Platform
  1. Windows
Did you try making the modification to your code that I posted in my last post?
If you put this in there and run it, it will pop-up a message box showing you what it is trying to name each sheet.
Hopefully, an obvious error will be seen (i.e. the same value shows up twice, a blank, an error, or an illegal character).
At the very least you will be able to see what value it is choking on (the last message box that pops up before the error).
 

eriklyon

New Member
Joined
Mar 9, 2016
Messages
15
Are you sure you are duplicating an existing name?
You could add this line of code to see exactly what it is trying to name each one:
Code:
Sub RenameSheets()
For Each ws In Worksheets
    MsgBox [FONT=Verdana]ws.Range("B1").Value[/FONT]
    ws.Name = ws.Range("B1").Value
Next ws
End Sub

this says I am trying to rename it 3/1/16 when in fact I am trying to rename it Tue March 01
 

Watch MrExcel Video

Forum statistics

Threads
1,122,536
Messages
5,596,748
Members
414,095
Latest member
George53

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
Top