no #Div/0! error - then error 1004 in VBA - What to do

[kdsrahi]

Hi All,

This is my first post on chandoo. I need your help. I am attaching a file. The "Input" sheet is used to input all data which then stores the data into "PartsData" sheet. Data entry in "Input" involves lot many data validation from "Lookuplist" as well as fetch data using index-match from "pNO Details" and gives back to input sheet. In this input sheet, VBA checks for all the field filled (i.e no blank field allowed).
Problem is that once all the fields are filled using dropdown menu's and if somebody changes some item say part number or section, other cells (which are picked up using dropdown menu) will remain same and will make the data wrong. To avoid this, I tried to add concept of reverse lookup and compared it so that any error in this comparision will be reflected in D13 as #Div/0! error. Then I added VBA lines (not in this attached file as I wanted to show original file - but will be pasted at the end of query), that if #Div/0! error is found then empty that cell and then original VBA will take care of empty cell. After that I again re-entered the same formula back in D13 so that sheet is ready for next cycle. This works fine if there is #Div/0! error. But if there is no error, the code simply hangs. So I want a solution to this. Can you help me in writing code that if there is no #Div/0! error then VBA should proceed to next step instead of giving error 1004.

Modified code is as follows(WHICH IS NOT WORKING AS DESIRED):

Option Explicit
Sub UpdateLogWorksheet()
  Dim historyWks As Worksheet
  Dim inputWks As Worksheet
  Dim nextRow As Long
  Dim oCol As Long
  Dim myRng As Range
  Dim myCopy As String
  Dim myCell As Range
 
  'cells to copy from Input sheet - some contain formulas
  myCopy = "D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15,D16,D17,D18,D19,D20,D21,D22,D23,D24,D25,D26,D27,D28,D29,D30,D31,D32,D33,D34,D35,D36,D37,D38"
  Set inputWks = Worksheets("Input")
  Set historyWks = Worksheets("PartsData")
  With historyWks
  nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  End With
 
  'With inputWks
  'Set myRng = .Range(myCopy)
  'If inputWks.UsedRange.SpecialCells(-4123, 16) = Range("D13") Then
  inputWks.UsedRange.SpecialCells(-4123, 16).ClearContents
  'Exit Sub
  'End If
  'End With
  With inputWks
  Set myRng = .Range(myCopy)
  If Application.CountA(myRng) <> myRng.Cells.Count Then
  MsgBox "Please fill in all the cells!"
  Else
  Range("D13").Formula = "=IF(E5=F5,INDEX('pNO dETAILS'!BB:BB,MATCH(Input!$D$11,'pNO dETAILS'!BA:BA,0)),1/0)"
  Exit Sub
  End If
  End With
 
  With historyWks
  historyWks.Unprotect Password:="1"
  With .Cells(nextRow, "A")
  .Value = Now
  .NumberFormat = "mm/dd/yyyy hh:mm:ss"
  End With
  .Cells(nextRow, "B").Value = Application.UserName
  oCol = 3
  For Each myCell In myRng.Cells
  historyWks.Cells(nextRow, oCol).Value = myCell.Value
  oCol = oCol + 1
  Next myCell
  historyWks.EnableAutoFilter = True
  historyWks.Protect Password:="1", UserInterFaceOnly:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
  End With
 
  'clear input cells that contain constants
  With inputWks
  On Error Resume Next
  inputWks.Unprotect Password:="1"
  With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
  .ClearContents
  Application.GoTo .Cells(1) ', Scroll:=True
  inputWks.Protect Password:="1"
  End With
  On Error GoTo 0
  End With
End Sub