in Excel macro want to validate columns, after wrting macro getting error - 1004 (Application)

[Simran Rastogi]

Pasted my full Code and now getting the below screenshot errors. please guide me.

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Scheme Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Scheme Code"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Fund Name"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Fund Code"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Block Type"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Effective date"
    Range("A1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    Columns("A:A").ColumnWidth = 13.86
    Columns("B:B").ColumnWidth = 15
    Columns("C:C").ColumnWidth = 12.86
    Columns("D:D").ColumnWidth = 12
    Columns("E:E").ColumnWidth = 11.14
    Columns("F:F").ColumnWidth = 13.86
End Sub
Sub Macro2()
'
' Macro2 Macro
'

'
    Sheets("Tabelle1").Select
    Sheets("Tabelle1").Name = "Fund Block"
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Gateway"
    Sheets("Fund Block").Select
    Range("A1:F1").Select
    Selection.Copy
    Sheets("Gateway").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub
Public last_row As Long

Sub CheckRows()
    Dim r As Long
    Dim c As Long
    'Dim emptyRow As Boolean

 CountRows
    With ActiveSheet
    Debug.Print last_row
    
        For r = 2 To last_row
            'Edited based on suggestion by Scott Craner
            If WorksheetFunction.CountA(.Range(.Cells(r, 1), .Cells(r, 6))) > 0 Then
            'emptyRow = True
            'For c = 1 To 33
            '    If Not IsEmpty(.Cells(r, c)) Then
            '        emptyRow = False
            '        Exit For
            '    End If
            'Next
            'If Not emptyRow Then
                If IsEmpty(.Cells(r, "A")) Or _
                   IsEmpty(.Cells(r, "B")) Or _
                   IsEmpty(.Cells(r, "C")) Or _
                   IsEmpty(.Cells(r, "D")) Or _
                   IsEmpty(.Cells(r, "E")) Or _
                   IsEmpty(.Cells(r, "F")) Then
                    MsgBox "Row " & r & " has some compulsory cells not filled in"
                End If
            End If
        Next
    End With
End Sub







Sub SValidateEffectiveDate()
CountRows
Set w = ActiveSheet.Range("F2:F" & last_row)
For Each c In w
If c.Value <> "" And Not IsDate(c) Then
c.ClearContents
'MsgBox "Only a date format is permitted in this cell."
End If

If c.Value <> "" And IsDate(c) Then
c.Value = CDate(c.Value)
c.Value = Format(c, "dd/mm/yyyy")

End If
Next c
End Sub
Sub numberselectMacro()
'
' Macro2 Macro
' macro to format Effective date
'
CountRows
'last_row
    Columns("F:F").Select
    Selection.NumberFormat = "dd/mm/yyyy;@"
End Sub



Sub FixedValueForBlockFundBlock()
'Dim w As Long

'updateby Extendoffice
 CountRows
Set w = Sheets("Fund Block").Range("E2:E" & last_row)
For Each c In w
c.Value = UCase(c.Value)
If c.Value <> "" And c.Value <> "ALL" Then
c.ClearContents
MsgBox "Only ALL block Type is permitted in this cell of gateway worksheet."
End If

Next c
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


firstRowColumnNamesMacro
    CountRows
CheckRows
FixedValueForBlockFundBlock
FixedValueForBlockGateway
SValidateEffectiveDate
DateSelectionCustom


End Sub
Sub firstRowColumnNamesMacro()
'
' Macro1 Macro
'

'
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Scheme Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Scheme Code"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Fund Name"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Fund Code"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Block Type"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Effective date"
    Range("A1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    Columns("A:A").ColumnWidth = 13.86
    Columns("B:B").ColumnWidth = 15
    Columns("C:C").ColumnWidth = 12.86
    Columns("D:D").ColumnWidth = 12
    Columns("E:E").ColumnWidth = 11.14
    Columns("F:F").ColumnWidth = 13.86
   
End Sub

Sub addsheetMacro()
'
' Macro2 Macro
'

'
    Sheets("Tabelle1").Select
    Sheets("Tabelle1").Name = "Fund Block"
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Gateway"
    Sheets("Fund Block").Select
    Range("A1:F1").Select
    Selection.Copy
    Sheets("Gateway").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub
Public last_row As Long

Sub CountRows()
    'Dim last_row As Long
    last_row = Cells(Rows.Count, 1).End(xlUp).Row
    MsgBox (last_row)
End Sub




Sub DateSelectionCustom()
'
' Macro2 Macro
' macro to format Effective date
'
CountRows
'last_row
    Columns("F:F").Select
    Selection.NumberFormat = "dd/mm/yyyy;@"
End Sub
Sub FixedValueForBlockGateway()
'updateby Extendoffice
CountRows
Set w = Sheets("Gateway").Range("E2:E" & last_row)
For Each c In w
c.Value = UCase(c.Value)
If c.Value <> "" And c.Value <> "IN" Then
c.ClearContents
MsgBox "Only IN block Type is permitted in this cell of gateway worksheet."
End If

Next c
End Sub







Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.DisplayAlerts = False

ActiveSheet.Delete

MsgBox "Sorry, Adding new Sheet is not allowed"
End Sub

 

[Fluff]

It should be

Dim w As Range