PDA

View Full Version : Solved: VBA issue



kevvukeka
07-12-2013, 03:40 AM
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.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

patel
07-12-2013, 04:39 AM
very long, attach please a sample file for testing

kevvukeka
07-15-2013, 12:35 AM
Hi All,

I could get the solution. I used the line "calculate" in the code. its working fine now.