Hi All,
I had a macro which was working fine till noon today. Basically I have a master data on which I need to run around 16 formula and extract 16 different type of errors. All the errors were then exported to new sheet. Everything was working fine, now suddenly the its exporting only blanks. After running the macro I re checked the excel, the formulae got inserted properly but the cell was blank. When I pressed F9, I could the see output. How should I handle this. Below is the code.
Its too long I know.[VBA]Sub commonerr_Rep()
Dim irowcount As Long, icolcount As Long
Dim i As Long, j As Long, T As Long, Coprwcount As Long, lForcount As Long, lnxtv As Long
Dim wb As Workbook, Auditwb2 As Workbook
Dim wsh1 As Worksheet, errsh As Worksheet
Dim cel As Range, cel2 As Range 'Never use a keyword as a variable name
Dim policynumber As Range
Dim claimnumber As Range
Dim provider As Range, Diagnosis1 As Range, rForrng1 As Range
Dim FirstFound As String
Dim wpi As Variant, rForcel1
'Used to append row number characters to 3 Ranges and row#s in another
Set wb = ThisWorkbook
Set wsh1 = Sheets("Master Sheet")
Sheets("Master Sheet").Select
With Sheets("Master Sheet")
.AutoFilterMode = False
End With
Range("CC1:CZ1").Clear
icolcount = wsh1.Cells(1, Columns.Count).End(xlToLeft).Column
irowcount = wsh1.Cells(Rows.Count, "E").End(xlUp).Row
lForcount = Sheets("Formula List").Cells(Rows.Count, "A").End(xlUp).Row
lnxtv = icolcount
wb.Activate
wsh1.Select
Cells(2, icolcount + 1).EntireColumn.Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Set rForrng1 = Sheets("Formula List").Range("A2:A" & lForcount)
On Error Resume Next
For Each rForcel1 In rForrng1
With wsh1
lnxtv = lnxtv + 1
.Cells(2, lnxtv).Formula = "=" & rForcel1
End With
Next rForcel1
With wsh1
.Range(Cells(2, icolcount + 1), Cells(2, icolcount + lForcount - 1)).Select
End With
Selection.AutoFill Destination:=Range(Cells(2, icolcount + 1), Cells(irowcount, icolcount + lForcount - 1)), Type:=xlFillDefault
wsh1.Range(Cells(2, icolcount + 1), Cells(irowcount, icolcount + lForcount - 1)).Copy
Set Auditwb2 = Workbooks.Add(1)
Set errsh = Auditwb2.Sheets("sheet1")
Auditwb2.Sheets("sheet1").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
i = errsh.UsedRange.Columns.Count
Coprwcount = errsh.UsedRange.Rows.Count
For T = 1 To i
j = errsh.Cells(Rows.Count, "A").End(xlUp).Row
Range(Cells(2, T + 1), Cells(Coprwcount, T + 1)).Copy
Range("A" & j + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next T
Range(Cells(2, 2), Cells(2, i)).EntireColumn.Delete
Range("A1").Value = "Error_Report"
errsh.UsedRange.Select
Selection.AutoFilter Field:=1, Criteria1:=""
errsh.UsedRange.Offset(1, 0).Resize((ActiveSheet.UsedRange.Rows.Count) - 1, (ActiveSheet.UsedRange.Columns.Count) - 1).Select
Selection.EntireRow.Delete
With errsh
.AutoFilterMode = False
End With
'Code to find the WP/WE Claims list
With wb.Sheets("Master Sheet")
wpi = CStr(.Cells(Rows.Count, "BX").End(xlUp).Row)
Set policynumber = .Range("BX1:BX" & wpi) 'Note the dot. It makes policynumber specific to Master
'wpi = CStr(.Cells(Rows.Count, "j").End(xlUp).Row)
Set claimnumber = .Range("j1:j" & wpi)
'wpi = CStr(.Cells(Rows.Count, "A").End(xlUp).Row)
Set provider = .Range("A1:A" & wpi)
Set Diagnosis1 = .Range("BN1:BN" & wpi)
End With
Application.ScreenUpdating = False
'The following code looks at each Policy number on the Policy List sheet
'and searches for that number in the policynumber Range on the Master Sheet.
'
'If that Policy is found, it appends the corresponding Claim number from the
'claimnumber Range of the Master sheet, and the Policy Number, to the end of
'the list on the Wrong List sheet. Then it looks for another instance of that Policy
wpi = CStr(wb.Sheets("Policy List").Cells(Rows.Count, 1).End(xlUp).Row)
For Each cel In wb.Sheets("Policy List").Range("A2:A" & wpi)
With policynumber
'Set cel2 = policynumber.Find(cel.Value, LookIn:=xlValues, LookAt:=xlWhole)
Set cel2 = policynumber.Find(What:=cel.Value, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cel2 Is Nothing Then
FirstFound = cel2.Address 'Set up test to check if Find is back at first cell found
Do
If provider.Cells(cel2.Row).Value = "UNITED STATES" Or provider.Cells(cel2.Row).Value = "CANADA" Then
With errsh
wpi = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(wpi, 1) = "WP,WE Claims | " & claimnumber.Cells(cel2.Row).Value & "|" & cel.Value & "|" & Diagnosis1.Cells(cel2.Row).Value 'Row#s in claimnumber and policynumber are equal
End With
End If
Set cel2 = policynumber.FindNext(cel2)
Loop While Not cel2 Is Nothing And cel2.Address <> FirstFound
End If
End With
Next cel
Application.ScreenUpdating = True
'--------------------------------------------------------------------------------------------------------
errsh.Range(Range("A2"), Range("A2").End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, Other:=True, OtherChar _
:="|"
errsh.Range("B1").Value = "Claim Number"
errsh.Range("C1").Value = "Other Info"
errsh.UsedRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
Range("A1:C1").Select
With Selection
.Font.Name = "Tahoma"
.Font.Size = 10
.Font.Bold = True
.Interior.Color = 12632256
End With
Cells.EntireColumn.AutoFit
Cells.AutoFilter
End Sub
Function myReverse(stringtocheck As String, stringtomatch As String)
myReverse = InStrRev(stringtocheck, stringtomatch)
End Function[/VBA]
Reply With Quote
