Excel VBA skips a lot of occurrences

Question

I have a Workbook with 6 Sheets. I am walking through them with For Each. And the task is: 1) Walk though every cell with specified Range

2) If cell is not empty AND contains ONLY number THEN add to the end of the cell " мм". Otherwise SKIP this cell.

But in fact, script does it good only for first sheet (Worksheet). It does no changes to other sheets. I don't know why this happens. I think, that there is some error or mistake in the code, but I double-checked it and everything seems to be correct. Help me please :)

Sub SaveWorksheetsAsCsv()
Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog
Dim r As Range
Dim rr As Range
Dim rrrrrr As Range
Dim cell As Range
k = Cells(Rows.Count, "A").End(xlUp).Row
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)

For Each xWs In Application.ActiveWorkbook.Worksheets

    If xWs.Name Like "Worksheet" Then
        Set r = Range("FA2:FA" & k)
        For Each cell0 In r
            If IsEmpty(cell0.Value) = False And IsNumeric(cell0.Value) = True Then
                cell0.Value = cell0.Value & " мм"
            End If
        Next
        'xWs.Columns(41).EntireColumn.Delete
    End If

    If xWs.Name Like "Worksheet 1" Then
        Set rr = Range("AG2:AG" & k)
        For Each cell1 In rr
            If IsEmpty(cell1.Value) = False And IsNumeric(cell1.Value) Then

                cell1.Value = cell1.Value & " мм"

            End If
        Next
        'xWs.Columns(126).EntireColumn.Delete
    End If

    If xWs.Name Like "Worksheet 5" Then
        Set rrrrrr = Range("FR2:FR" & k)
        For Each cell5 In rrrrrr
            If IsEmpty(cell5.Value) = False And IsNumeric(cell5.Value) Then

                cell5.Value = cell5.Value & " мм"

            End If
        Next
    End If

    xWs.SaveAs xDir & "\" & xWs.Name, xlCSV, local:=True

Next
End Sub

Answer 1

You can shorten-up and utilize your code a lot.

First, your k = Cells(Rows.Count, "A").End(xlUp).Row trying to get the last row, needs to be inside the For Each xWs In Application.ActiveWorkbook.Worksheets , since the last row will be different for each worksheet.

Second, instead of multiple Ifs, you can use Select Case.

Third, there is no need to have 3 different objects for Range, like r, rr, and rrr. The same goes for cell0, cell1 and cell5, you can use just one r and cell.

The only thing different inside your If (my Select Case) is the range you set r. The rest, looping through r.Cells is the same for all 3 criterias, so you can take this part outside the loop, and have it only once.

Modifed Code

Option Explicit

Sub SaveWorksheetsAsCsv()

Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog
Dim r As Range
Dim cell As Range
Dim k As Long

Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)

For Each xWs In ThisWorkbook.Worksheets ' it's safer to use ThisWorkbook is you reffer to the worksheets inside the workbook which thid code resides
    With xWs
        ' getting the last row needs to be inside the loop
        k = .Cells(.rows.Count, "A").End(xlUp).Row

        Set r = Nothing ' reset Range Object

        Select Case .Name
            Case "Worksheet"
                Set r = .Range("FA2:FA" & k)
                'xWs.Columns(41).EntireColumn.Delete

            Case "Worksheet 1"
                Set r = .Range("AG2:AG" & k)
                'xWs.Columns(126).EntireColumn.Delete

            Case "Worksheet 5"
                Set r = .Range("FR2:FR" & k)

        End Select

        ' check if r is not nothing (it passed one of the 3 Cases in the above select case)
        If Not r Is Nothing Then
            For Each cell In r
                If IsEmpty(cell.Value) = False And IsNumeric(cell.Value) Then
                    cell.Value = cell.Value & " мм"
                End If
            Next cell
        End If

        .SaveAs xDir & "\" & .Name, xlCSV, Local:=True
    End With

Next xWs

End Sub

Answer 2

These sets of statements need to be adjusted to correct sheet references. Current code will always look at active sheet and the range reference is not qualified.

Set r = Range("FA2:FA" & k)

Set r = xWs.Range("FA2:FA" & k)