Hi,
I have entered some VBA code into my sheet ( right click & paste) for to achieve the results & it works well.
I have another macro in module it allows to insert rows & fill the formula from above row.
Whenever i run a macro I am receiving a Run-time error '13' Type mismatch in sheet code.
I don't have much knowledge of VB just searching macros what i need & trial, so please any help will be appreciated
1) Module Macro
2) Sheet Macro
</markhill@charm.net.nospam>
I have entered some VBA code into my sheet ( right click & paste) for to achieve the results & it works well.
I have another macro in module it allows to insert rows & fill the formula from above row.
Whenever i run a macro I am receiving a Run-time error '13' Type mismatch in sheet code.
I don't have much knowledge of VB just searching macros what i need & trial, so please any help will be appreciated
1) Module Macro
Code:
Sub InsertRowsAndFillFormulas_caller() '-- this macro shows on Tools, Macro..., Macros (Alt+F8) dialog
Call InsertRowsAndFillFormulas
End Sub
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)
' Documented: http://www.mvps.org/dmcritchie/excel/insrtrow.htm
' Re: Insert Rows -- 1997/09/24 Mark Hill <markhill@charm.net.nospam>
' row selection based on active cell -- rev. 2000-09-02 David McRitchie
Dim x As Long
ActiveCell.EntireRow.Select 'So you do not have to preselect entire row
If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"How many rows do you want to add?", Title:="Add Rows", _
Default:=1, Type:=1) 'Default for 1 row, type 1 is number
If vRows = False Then Exit Sub
End If
'if you just want to add cells and not entire rows
'then delete ".EntireRow" in the following line
'rev. 2001-01-17 Gary L. Brown, programming, Grouped sheets
Dim sht As Worksheet, shts() As String, i As Long
ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0
For Each sht In _
Application.ActiveWorkbook.Windows(1).SelectedSheets
Sheets(sht.Name).Select
i = i + 1
shts(i) = sht.Name
x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup
Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
Resize(rowsize:=vRows).Insert Shift:=xlDown
Selection.AutoFill Selection.Resize( _
rowsize:=vRows + 1), xlFillDefault
On Error Resume Next 'to handle no constants in range -- John McKee 2000/02/01
' to remove the non-formulas -- 1998/03/11 Bill Manville
Selection.Offset(1).Resize(vRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
Next sht
Worksheets(shts).Select
End Sub2) Sheet Macro
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'for row sorting
If Target.Column = Range("AN1").Column Then
Dim lRw As Long
lRw = Cells(Rows.Count, "AN").End(xlUp).Row
Range("A4:BZ" & lRw).Sort Key1:=Range("K4"), Order1:=xlAscending, Header:=xlNo
End If
'for capital typing
If Target.Column = 6 Then
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
End If
' for cell auto lock once enter
Dim changed As Range
Set changed = Intersect(Target, Range("C4:AN551"))
If Not changed Is Nothing Then
If TargetLocked <> True Then
ActiveSheet.Unprotect ("123456789")
Target.Locked = True
ActiveSheet.Protect ("123456789"), userinterfaceonly:=True, AllowFiltering:=True
Else
End If
End If
If Intersect(Target, Range("AN4:AN551")) Is Nothing Then Exit Sub
If Target.Value <> "RC" Then
Target.Locked = True
Else
Target.Locked = False
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Pword As String
Dim changed As Range
Set changed = Intersect(Target, Range("C4:AN551"))
If Not changed Is Nothing Then
If Target.Locked = True Then
UserForm1.TextBox1.Value = ""
UserForm1.TextBox1.SetFocus
UserForm1.Show
Pword = UserForm1.TextBox1
On Error GoTo Getout
ActiveSheet.Unprotect Pword
'for cell contents remains after double click
If Target.Column = 40 Then
Target.ClearContents
End If
Target.Locked = False
ActiveSheet.Protect Pword
End If
End If
Exit Sub
Getout: MsgBox "Wrong Password", vbCritical, "Sorry :)"
' for cell protected error stop
Cancel = True
End Sub</markhill@charm.net.nospam>
!!!
