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

Simran Rastogi

New Member
Joined
May 28, 2021
Messages
1
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Pasted my full Code and now getting the below screenshot errors. please guide me.


VBA Code:
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


1622213185223.png

1622213609975.png
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,772
Office Version
  1. 365
Platform
  1. Windows
It should be
VBA Code:
Dim w As Range
 

Forum statistics

Threads
1,143,907
Messages
5,721,443
Members
422,362
Latest member
elliotpat

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