1

I am trying to add a data validation list through vba on my excel sheet. But every few times I try to run this code I keep getting run time error 1004 - Method 'Add' of object 'validation' failed. Below is the full code.

Option Explicit
Sub rwins()
Dim w As Workbook
Dim ws As Worksheet
Dim ButtonText As String
Dim fr1 As Long
Dim lr1 As Long
Dim i As Long
Dim wss As Worksheet
Dim cl As Range
Dim rr2 As Range
Dim fr2 As Long
Dim lr2 As Long
Dim cst As String
Dim r As Range
Dim v As String
Dim dtrr As Range
Dim cl2 As Range
Dim r2 As Range
Dim bt2 As Shape
Dim btc As Shape
Dim ld As Long
Dim ind As Range
Dim acr As Range
Dim cmb As Shape
Dim cmb2 As Shape
Dim j As Long

Set w = Workbooks("MCC_LEDGER.xlsm")
Set ws = w.ActiveSheet
Set wss = w.Worksheets("LIST")

fr1 = ws.UsedRange.Rows(ws.UsedRange.Rows(1).Count).Row
lr1 = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
fr2 = wss.UsedRange.Rows(wss.UsedRange.Rows(1).Count).Row
lr2 = wss.UsedRange.Rows(wss.UsedRange.Rows.Count).Row

ButtonText = Application.Caller

For i = fr1 To lr1
 If StrComp(ButtonText, ws.Cells(i, 2).Value) = 0 Then
   Exit For
 End If
Next

ws.Range("A" & i + 4).EntireRow.Insert

ld = ldn + 1

With ws.Range("P" & i + 4)
  ws.Buttons.Add(.Left, .Top, .Width, .Height).Name = CStr(ld)
End With

Set btc = ws.Shapes(CStr(ld))

btc.AlternativeText = "Calculate amount,cess, bill amount etc."
btc.Select
Selection.Characters.Text = "CALCULATE" '<<--- calculate button          would come before ld. no. ideally for worksheet change event to work easily.

With Selection.Font
    .Name = "ArialNarrow"
    .Size = 10
End With
 
btc.OnAction = "'" & w.Name & "'!clc"

ws.Range("E" & i + 4) = Day(Date) '<<---- date would come before ld     no. for undo to function.
ws.Range("D" & i + 4) = ld

First Range to add Data Validation to is named "ind"

Set ind = ws.Range("F" & i + 4)

ind.Activate

With ind.Validation
 .Delete
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,Operator:=_
 xlBetween, Formula1:="DEBIT,CREDIT"
End With
cst = ""
Set rr2 = wss.Range("B" & fr2 + 1, "B" & lr2)

For Each r In rr2
  If cst = "" Then
   cst = CStr(r.Value)
  Else
   cst = cst & "," & CStr(r.Value)
  End If
Next r

Second Range to add validation to is named "acr"

Set acr = ws.Range("G" & i + 4)

acr.Activate

With acr.Validation
 .Delete
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,Operator:=_
 xlBetween, Formula1:=cst
End With

lr1 = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row


With ws.Range("Q" & i + 4)
 ws.Buttons.Add(.Left, .Top, .Width, .Height).Name = CStr(ButtonText & "$" & ld)
End With

Set bt2 = ws.Shapes(CStr(ButtonText & "$" & ld))

bt2.AlternativeText = "Submit Entry"
bt2.Select
Selection.Characters.Text = "SUBMIT"

With Selection.Font
   .Name = "ArialNarrow"
   .Size = 12
End With
 
 bt2.OnAction = "'" & w.Name & "'!adentr"
 
 ws.Range("D" & i + 4).Select

 End Sub

Update - Full code has been put in as requested.

0 Answers0