check lengh of the values and move to next sheet

[aravindhan_3]

Hi
I have some 3000 rows of data where i need to check something in column B & E

I need to check 2 conditions in column B & Column E
condition 1: values in Col E should have contain -3numbers like -123,-456,-785 etc only numbers no alpha.
that is suppliarA-123.pdf is correct,
suplerhab-1452 is incorrect, that is just check if the value contains
-3digits if not then the entire row should be moved to next sheet.

condition 2: Check in Column F, if the value is only 5digis-4digits something like 12455-4125 all numbers no alpha and no special charecters like +,comma,@,# etc if so then those rows should be moved to next sheet

i want both the condition to meet, if one condition is missing then the enteire row should be moved to next sheet.

Regards
Arvind

[mdmackillop]

Option Explicit
Sub TestTwo()
Dim Rng As Range, cel As Range, tgt As Range
Dim tmp
Dim Test1 As Boolean, Test2 As Boolean
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cel In Rng
tmp = Val(Split(cel.Offset(, 1), "-")(1))
Test1 = tmp > 99 And tmp < 1000
tmp = Split(cel.Offset(, 5), "-")
If UBound(tmp) = 1 Then
Test2 = --tmp(0) > 9999 And --tmp(0) < 100000 And --tmp(1) > 999 And --tmp(1) < 10000
End If
If Not (Test1 And Test2) Then
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
With cel.EntireRow
.Copy tgt
.ClearContents
End With
End If
Next
End Sub

[aravindhan_3]

Hi,

Thanks for you code is working fine when the digit are in numbers. like 12345-4578 that is the macro assumes 12345-4578 is correct and also 1245a-4578 is also correct, but if the value contains alphabetics then its incorrect.

could you please let me know the changes i need to make to work this?
some hint:
12345-8578 is correct
1234-45789 is incorrect
12345-a145 is incorrect
12345+1245 is incorrect

on whole there should be only 5digit-4digits all numerics and alphabetics and special characters expet hypen(-).

Thanks for help again
Arvind

[mdmackillop]

If you could supply some varied examples for proper testing, I'll have a look at this again.

[aravindhan_3]

Hi,

I have attached the file for you to have a look.

Arvind

[mdmackillop]

condition 2: Check in Column F, if the value is only 5digis-4digits something like 12455-4125 all numbers no alpha and no special charecters like +,comma,@,# etc if so then those rows should be moved to next sheet
I cannot reconcile this with your values. F3 and F14 do not have the form #####-####.

[aravindhan_3]

Hi,

Thanks for you response, however as i said #####-#### is correct or #####-#### and another set of this #####-#### is also correct
that is #####-####-#####-#### two sets of 5-4 are there so i consider this is correct.

If this is not possible to reconsile i will avoid entering the values like this and I assure that it will have only #####-#### not two sets.

Regards
Arvind

[mdmackillop]

And what about ##### or #### as F14
A solution is not possible without a clear set of rules .

[aravindhan_3]

Hi,

Sorry for not being clear.

The condition for Type F, Type G is the number should only be 4 digit or set of 4 digits like #### or ####-#### rest everything is incorrect.


Thanks for help again.
Arvind

[mdmackillop]

Option Explicit
Sub TestTwo()
Dim Rng As Range, cel As Range, tgt As Range
Dim tmp
Dim Test1 As Boolean, Test2 As Boolean
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cel In Rng
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
'cel.Select
tmp = Val(Split(cel.Offset(, 1), "-")(1))
Test1 = tmp > 99 And tmp < 1000
If Test1 Then
Select Case Right(cel.Offset(, 4), 1)
Case "A", "B", "C", "D", "E"
tmp = Split(cel.Offset(, 5), "-")
Select Case UBound(tmp)
Case 1
Test2 = Val(tmp(0)) > 9999 And Val(tmp(0)) < 100000 And Val(tmp(1)) > 999 And Val(tmp(1)) < 10000
Case 3
Test2 = Val(tmp(0)) > 9999 And Val(tmp(0)) < 100000 And Val(tmp(1)) > 999 And Val(tmp(1)) < 10000 _
And Val(tmp(2)) > 9999 And Val(tmp(2)) < 100000 And Val(tmp(3)) > 999 And Val(tmp(3)) < 10000
End Select
Case "F", "G"
tmp = cel.Offset(, 5)
If InStr(tmp, "-") = 0 Then
Test2 = Val(tmp) > 999 And Val(tmp) < 10000
Else
tmp = Split(cel.Offset(, 5), "-")
Test2 = Val(tmp(0)) > 999 And Val(tmp(0)) < 10000 And Val(tmp(1)) > 999 And Val(tmp(1)) < 10000
End If
End Select
If Not (Test1 And Test2) Then
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
Else
cel.Offset(, 6) = "Correct"
End If
Else
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
End If
Next
End Sub

[aravindhan_3]

Hi,

Thanks a lot its working fine with the sample data which i provided its awsome. I need some more helo on this.
On my original data instead of Type A, Type B,

I have original names as below
Type A - Direct AAH Doc
Type B - Direct Delivery SBO
Type C - Direct Delivery Generic
Type D - Direct Unichem Doc
Type E - Direct Delivery Non Comp Generic

Type F - Direct Debit Only Rtn Others
Type G - Direct Generic Rtn Others

please help me to make changes on this?
Sorry & Please dont mind if I again come back with questions

Regards
Arvind

[mdmackillop]

All you need to do is substitute correct details in the Select Case statements. It's just a typing exercise.

Select Case cel.Offset(, 4)
Case "Direct AAH Doc" etc.

[aravindhan_3]

Hi,

Thanks for your help, I have quich question on this
Col B Col F
ERRIED BAKERIES-433.pdf 76381-2919 macro says it correct
ERRIED BAKERIES-020.pdf 37390-3239 macro says it incorrect

but the condition matches for same. that is Col B contain -### and Colu F has #####-#### please help me on this.

I have attached my original data & data after running the macro for your reference. can you please run a macro and see if that works fine.

Thanks once again for you help on this.

Arvind

[aravindhan_3]

I am attaching file after macro

Thanks

[mdmackillop]

The issues is that Val (used to ignore non-numerics) is valuing 020 as 20. Add in a line of code to substitute 1 for 0 in the value to be tested. You'll need to create a variable to hold this value.

[mdmackillop]

A slight change to methodology

Option Explicit
Sub TestTwo()
Dim Rng As Range, cel As Range, tgt As Range
Dim tmp, Data As String
Dim Test1 As Boolean, Test2 As Boolean
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cel In Rng
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
cel.Select
If InStr(cel.Offset(, 1), "-") > 0 Then
tmp = Split(cel.Offset(, 1), "-")(1)
Test1 = tmp Like "###.*"
If Test1 Then
Select Case cel.Offset(, 4)
Case "Direct AAH Doc", "Direct Delivery Generic", "Direct Unichem Doc", "Direct Delivery Non Comp Generic", _
"Direct Delivery Non Comp SBO", "Direct Delivery SBO"
Data = cel.Offset(, 5)
tmp = Split(Data, "-")
Select Case UBound(tmp)
Case 1
Test2 = Data Like "#####-####"
Case 3
Test2 = Data Like "#####-####-#####-####"
Case 5
Test2 = Data Like "#####-####-#####-####-#####-####"
Case 7
Test2 = Data Like "#####-####-#####-####-#####-####-#####-####"
End Select
Case "Direct Debit Only Rtn Others", "Direct Generic Rtn Others"
Data = cel.Offset(, 5)
If InStr(Data, "-") = 0 Then
Test2 = Data Like "####"
Else
tmp = Split(cel.Offset(, 5), "-")
Test2 = Data Like "####-####"
End If
End Select
If Not (Test1 And Test2) Then
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
Else
cel.Offset(, 6) = "Correct"
End If
Else
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
End If
End If
Next
End Sub

[aravindhan_3]

Hi,

I really thank you very much for helping me without hesitation. I have some more questions and modification on this ( I am getting too many ideas when I implement the macro on my live data)

1. The macro considers all other items except the below 7 items are incorrect, "Direct AAH Doc", "Direct Delivery Generic", "Direct Unichem Doc",
"Direct Delivery Non Comp Generic", "Direct Delivery Non Comp SBO", "Direct Delivery "Direct Debit Only Rtn Others", "Direct Generic Rtn Others" So I dont want to check anything if the values in col E is not one among the above 7 items just ignore those rows

2. The macro has 2 tests one is check if col B has -### if correct then go and check the conditions for 1st five items and next two items that is
"Direct Debit Only Rtn Others" & "Direct Generic Rtn Others"

I need a changes on this: for first 5 items check both the test 1 & 2 but for the next 2 items ( "Direct Debit Only Rtn Others" & "Direct Generic Rtn Others" ) just check only the test2 and no need test 1 that is -###
If this part is done I think everything is solved...


Thanks in advance for you help again.
Arvind

[aravindhan_3]

Hi,

please guide me to make this changes when u get time

Regards
Arvind

[aravindhan_3]

Hi mdmackillop,

Sorry if I am bothering you.. please help me on this

Arvind

[aravindhan_3]

Hi,

I tried to make changes like this.. somewhere I am going wrong... getting Else without If error
please help me to resolve this


Option Explicit
Sub TestTwo()
Dim Rng As Range, cel As Range, tgt As Range
Dim tmp, Data As String
Dim Test1 As Boolean, Test2 As Boolean
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cel In Rng

Select Case cel.Offset(, 4)
Case "Direct AAH Doc", "Direct Delivery Generic", "Direct Unichem Doc", "Direct Delivery Non Comp Generic", _
"Direct Delivery Non Comp SBO", "Direct Delivery SBO", "Direct Debit Only Rtn Others", "Direct Generic Rtn Others"
End Select
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
cel.Select
If InStr(cel.Offset(, 1), "-") > 0 Then
tmp = Split(cel.Offset(, 1), "-")(1)
Test1 = tmp Like "###.*"

Select Case cel.Offset(, 4)
Case "Direct Debit Only Rtn Others", "Direct Generic Rtn Others"
Data = cel.Offset(, 5)
If InStr(Data, "-") = 0 Then
Test2 = Data Like "####"
Else
tmp = Split(cel.Offset(, 5), "-")
Test2 = Data Like "####-####"
End If
End Select
If Not (Test2) Then
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
Else
cel.Offset(, 6) = "Correct"
Else
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
Else
If Test1 Then
Select Case cel.Offset(, 4)
Case "Direct AAH Doc", "Direct Delivery Generic", "Direct Unichem Doc" & _
"Direct Delivery Non Comp Generic", "Direct Delivery Non Comp SBO", "Direct Delivery SBO"
Data = cel.Offset(, 5)
tmp = Split(Data, "-")
Select Case UBound(tmp)
Case 1
Test2 = Data Like "#####-####"
Case 3
Test2 = Data Like "#####-####-#####-####"
Case 5
Test2 = Data Like "#####-####-#####-####-#####-####"
Case 7
Test2 = Data Like "#####-####-#####-####-#####-####-#####-####"
End Select

If Not (Test1 And Test2) Then
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
Else
cel.Offset(, 6) = "Correct"
End If
Else
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
End If
End If
Next
End Sub

Arvind

[mdmackillop]

Hi Arvind,
Use a code indenter as above (btw use the green VBA button instead of Code tags). You can see where the End If is missing.

[aravindhan_3]

Hi,

Thanks for you reply, I really dont know where am i going wrong.. it keeps throwing me error, esle without if, next without for..

checked line by line,, but somewhere something is going wrong..

Arvind

[mdmackillop]

untested
Option Explicit
Sub TestTwo()
Dim Rng As Range, cel As Range, tgt As Range
Dim tmp, Data As String
Dim Test1 As Boolean, Test2 As Boolean
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cel In Rng
Select Case cel.Offset(, 4) 'This is doing nothing
Case "Direct AAH Doc", "Direct Delivery Generic", "Direct Unichem Doc", _
"Direct Delivery Non Comp Generic", "Direct Delivery Non Comp SBO", _
"Direct Delivery SBO", "Direct Debit Only Rtn Others", "Direct Generic Rtn Others"
End Select
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
cel.Select
If InStr(cel.Offset(, 1), "-") > 0 Then
tmp = Split(cel.Offset(, 1), "-")(1)
Test1 = tmp Like "###.*"
Select Case cel.Offset(, 4)
Case "Direct Debit Only Rtn Others", "Direct Generic Rtn Others"
Data = cel.Offset(, 5)
If InStr(Data, "-") = 0 Then
Test2 = Data Like "####"
Else
tmp = Split(cel.Offset(, 5), "-")
Test2 = Data Like "####-####"
End If
End Select
If Not (Test2) Then
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
Else
cel.Offset(, 6) = "Correct"
End If 'add

'delete
'Else
' cel.Offset(, 6) = "Incorrect"
' With cel.EntireRow
' .Copy tgt
' .ClearContents
' End With
If Test1 Then
Select Case cel.Offset(, 4)
Case "Direct AAH Doc", "Direct Delivery Generic", "Direct Unichem Doc" & _
"Direct Delivery Non Comp Generic", "Direct Delivery Non Comp SBO", "Direct Delivery SBO"
Data = cel.Offset(, 5)
tmp = Split(Data, "-")
Select Case UBound(tmp)
Case 1
Test2 = Data Like "#####-####"
Case 3
Test2 = Data Like "#####-####-#####-####"
Case 5
Test2 = Data Like "#####-####-#####-####-#####-####"
Case 7
Test2 = Data Like "#####-####-#####-####-#####-####-#####-####"
End Select
End Select 'Add
If Not (Test1 And Test2) Then
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
Else
cel.Offset(, 6) = "Correct"
End If
Else
cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
.ClearContents
End With
End If
End If
Next

End Sub

[aravindhan_3]

Hi,

Thanks again, I have made the changes on the code as below, i dont get any error message but my result are incorrect.
the macro does not ignore the below items instead it gives me incorrect
Select Case cel.Offset(, 4) 'This is doing nothing for the below Items in Col E
Case "Depot Delivery Document", "Depot Return Doc", "Depot Supplier Mail", "Direct POD Responses", "Direct Price Query", "Direct Supplier Mail Query"
End Select and for few items it gives as incorrect

I have attached the file with the actual data with the code, please help me where i am going wrong

Arvind

[mdmackillop]

Please verify result and advise of any wrong answers

Option Explicit
Sub TestTwo()
Dim Rng As Range, cel As Range, tgt As Range
Dim tmp, Data As String
Dim Test1 As Boolean, Test2 As Boolean
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cel In Rng
Select Case cel.Offset(, 4)
Case "Depot Delivery Document", "Depot Return Doc", "Depot Supplier Mail", _
"Direct POD Responses", "Direct Price Query", "Direct Supplier Mail Query", _
"Direct Delivery News & Mags"
'Do nothing
cel.Offset(, 6) = "Ignored"
Case "Direct Debit Only Rtn Others", "Direct Generic Rtn Others"
'Test2 Only
Test1 = True
Test2 = False
Data = cel.Offset(, 5)
tmp = Split(Data, "-")
Select Case UBound(tmp)
Case 1
Test2 = Data Like "#####-####"
Case 3
Test2 = Data Like "#####-####-#####-####"
Case 5
Test2 = Data Like "#####-####-#####-####-#####-####"
Case 7
Test2 = Data Like "#####-####-#####-####-#####-####-#####-####"
End Select
Case Else
'Test1 & Test2
Test1 = False
Test2 = False
'Test1
If InStr(cel.Offset(, 1), "-") > 0 Then
tmp = Split(cel.Offset(, 1), "-")(1)
Test1 = tmp Like "###.*"
End If
'Test2
If Test1 Then
Data = cel.Offset(, 5)
tmp = Split(Data, "-")
Select Case UBound(tmp)
Case 1
Test2 = Data Like "#####-####"
Case 3
Test2 = Data Like "#####-####-#####-####"
Case 5
Test2 = Data Like "#####-####-#####-####-#####-####"
Case 7
Test2 = Data Like "#####-####-#####-####-#####-####-#####-####"
End Select
End If
End Select
If Not (Test1 And Test2) Then
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
If cel.Offset(, 6) = "" Then cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
'.Copy tgt
'.ClearContents
End With
Else
cel.Offset(, 6) = "Correct"
End If
Next

End Sub

[aravindhan_3]

Hi,

The macro is doing a wonderfull job, however I am getting incorrect results for few items.

1. Case "Depot Delivery Document", "Depot Return Doc", "Depot Supplier Mail", _
"Direct POD Responses", "Direct Price Query", "Direct Supplier Mail Query"
'Do nothing
cel.Offset(, 6) = "Ignored"
For the above code the macro ignores few items and says Correct for few items.

2. Case "Direct Debit Only Rtn Others", "Direct Generic Rtn Others"
'Test2 Only ' either 4 digit or 4-4 digits or 4-4-4digits
Test1 = True
Test2 = False
Data = cel.Offset(, 5)
tmp = Split(Data, "-")
Select Case UBound(tmp)
Case 1
Test2 = Data Like "####"
Case 3
Test2 = Data Like "####-####"
Case 5
Test2 = Data Like "####-####=####"
Case 7
Test2 = Data Like "####-####-####-####-####"
End Select for these two items "Direct Debit Only Rtn Others", "Direct Generic Rtn Others" if the value is 4 digit or 4-4 digit or 4-4-4 digits it should be correct but the macro writes as incorrect, I think its because of the "-" tmp = Split(Data, "-")if delete this line I get as correct for 4 digits and incorrect for 4-4 digits.

I have attached the file with the result as per macro & added a column for the desired result.

Thanks for your help
Arvind

[mdmackillop]

Option Explicit
Sub TestTwo()
Dim Rng As Range, cel As Range, tgt As Range
Dim tmp, Data As String
Dim Test1 As Boolean, Test2 As Boolean
Columns("G").ClearContents
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cel In Rng
cel.Offset(, 5).Select
Select Case cel.Offset(, 4)
Case "Depot Delivery Document", "Depot Return Doc", "Depot Supplier Mail", _
"Direct POD Responses", "Direct Price Query", "Direct Supplier Mail Query"
'Do nothing
cel.Offset(, 6) = "Ignored"
Case "Direct Debit Only Rtn Others", "Direct Generic Rtn Others"
'Test2 Only ' either 4 digit or 4-4 digits or 4-4-4digits
Test1 = True
Test2 = False
Data = cel.Offset(, 5)
tmp = Split(Data, "-")
Select Case UBound(tmp)
Case 0
Test2 = Data Like "####"
Case 1
Test2 = Data Like "####-####"
Case 2
Test2 = Data Like "####-####-####"
Case 3
Test2 = Data Like "####-####-####-####"
Case 4
Test2 = Data Like "####-####-####-####-####"
Case 5
Test2 = Data Like "####-####-####-####-####-####"
End Select
Case Else
'Test1 & Test2
Test1 = False
Test2 = False
'Test1
If InStr(cel.Offset(, 1), "-") > 0 Then
tmp = Split(cel.Offset(, 1), "-")(1)
Test1 = tmp Like "###.*"
End If
'Test2 either 5-4 digits or 5-4-5-4 or 5-4-5-4-5-4 digits
If Test1 Then
Data = cel.Offset(, 5)
tmp = Split(Data, "-")
Select Case UBound(tmp)
Case 1
Test2 = Data Like "#####-####"
Case 3
Test2 = Data Like "#####-####-#####-####"
Case 5
Test2 = Data Like "#####-####-#####-####-#####-####"
Case 7
Test2 = Data Like "#####-####-#####-####-#####-####-#####-####"
End Select
End If
End Select
If Not (Test1 And Test2) Then
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
If cel.Offset(, 6) = "" Then cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
.Copy tgt
'.ClearContents
End With
Else
If cel.Offset(, 6) = "" Then cel.Offset(, 6) = "Correct"
End If
Next
End Sub

[aravindhan_3]

Hi,

Sorry for the delay in response, I took time to test the code with the live data many times and now its working for me.

this is the final code I use
Option Explicit
'code written by mdmackillop for the thread http://www.vbaexpress.com/forum/newreply.php?do=newreply&noquote=1&p=187372
Sub Error_Check()
Sheets("Indexed Documents Report").Select
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Sheet2"
Sheets("Indexed Documents Report").Select
Dim Rng As Range, cel As Range, tgt As Range
Dim tmp, Data As String
Dim Test1 As Boolean, Test2 As Boolean
Columns("G").ClearContents
Set Rng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
For Each cel In Rng
cel.Offset(, 5).Select
Select Case cel.Offset(, 4)
Case "Depot Delivery Document", "Depot Return Doc", "Depot Supplier Mail", _
"Direct POD Responses", "Direct Price Query", "Direct Supplier Mail Query"
'Do nothing
cel.Offset(, 6) = "Ignored"
Case "Direct Debit Only Rtn Others", "Direct Generic Rtn Others"
'Test2 Only ' either 4 digit or 4-4 digits or 4-4-4digits
Test1 = True
Test2 = False
Data = cel.Offset(, 5)
tmp = Split(Data, "-")
Select Case UBound(tmp)
Case 0
Test2 = Data Like "####"
Case 1
Test2 = Data Like "####-####"
Case 2
Test2 = Data Like "####-####-####"
Case 3
Test2 = Data Like "####-####-####-####"
Case 4
Test2 = Data Like "####-####-####-####-####"
Case 5
Test2 = Data Like "####-####-####-####-####-####"
End Select
Case Else
'Test1 & Test2
Test1 = False
Test2 = False
'Test1
If InStr(cel.Offset(, 1), "-") > 0 Then
tmp = Split(cel.Offset(, 1), "-")(1)
Test1 = tmp Like "###.*"
End If
'Test2 either 5-4 digits or 5-4-5-4 or 5-4-5-4-5-4 digits
If Test1 Then
Data = cel.Offset(, 5)
tmp = Split(Data, "-")
Select Case UBound(tmp)
Case 1
Test2 = Data Like "#####-####"
Case 3
Test2 = Data Like "#####-####-#####-####"
Case 5
Test2 = Data Like "#####-####-#####-####-#####-####"
Case 7
Test2 = Data Like "#####-####-#####-####-#####-####-#####-####"
End Select
End If
End Select
If Not (Test1 And Test2) Then
Set tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
If cel.Offset(, 6) = "" Then cel.Offset(, 6) = "Incorrect"
With cel.EntireRow
'.Copy tgt
'.ClearContents
End With
Else
If cel.Offset(, 6) = "" Then cel.Offset(, 6) = "Correct"
End If
Next
Copy Paste
Sheets("Indexed Documents Report").Select
Rows("1:1").Select
Selection.Copy
Sheets("Sheet2").Select
Rows("1:1").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Sheets("Indexed Documents Report").Select
Range("G1").Select
ActiveCell.FormulaR1C1 = "Result"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("G1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=7, Criteria1:="Incorrect"
Range("E21").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("Indexed Documents Report").Select
Selection.AutoFilter
Range("A1").Select

'pivot and format
Range("A1").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"'Indexed Documents Report'!R1C1:R65000C7").CreatePivotTable TableDestination _
:="", TableName:="PivotTable4", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable4").AddFields RowFields:=Array( _
"Indexed By", "Document Type")
ActiveSheet.PivotTables("PivotTable4").PivotFields("Document Type"). _
Orientation = xlDataField
ActiveWorkbook.ShowPivotTableFieldList = True
ActiveWorkbook.ShowPivotTableFieldList = False
Application.CommandBars("PivotTable").Visible = False
Columns("A:A").EntireColumn.AutoFit
Sheets("Indexed Documents Report").Select
Columns("A:A").Select
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Columns( _
"A:A"), CopyToRange:=Columns("I:I"), Unique:=True
Columns("I:I").Select
Selection.Cut
Sheets("Sheet3").Select
Columns("H:H").Select
ActiveSheet.Paste
Range("I3:J3").Select
Range("J3").Activate
Columns("H:H").EntireColumn.AutoFit
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF('Indexed Documents Report'!Criteria,Sheet3!RC[-1])"
Range("I2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlUp)).Select
Range("I2:I35").Select
Selection.FillDown
Range("I3").Select
ActiveWindow.SmallScroll Down:=-3
ActiveCell.FormulaR1C1 = _
"=COUNTIF('Indexed Documents Report'!Criteria,Sheet3!RC[-1])"
Range("I36").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-34]C:R[-1]C)"
Range("I36").Select
Selection.Font.Bold = True
Range("H36").Select
ActiveCell.FormulaR1C1 = "Total"
Range("H37").Select
ActiveWorkbook.Save
Range("H36").Select
ActiveWindow.SmallScroll Down:=0
Range("K1").Select

Sheets("Sheet3").Select
Range("J2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Sheet2!C[-9],Sheet3!RC[-2])"
Range("J2:J35").Select
Selection.FillDown
Range("J36").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-34]C:R[-1]C)"
Range("J36").Select
Selection.Font.Bold = True
Range("J1").Select
ActiveCell.FormulaR1C1 = "Incorrect"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Total Count"
Range("I2").Select
Columns("I:I").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Range("I1:J1").Select
Selection.Font.Bold = True
Columns("J:J").EntireColumn.AutoFit
Columns("J:J").ColumnWidth = 10.43
Range("H1:J1").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("H1:J1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ActiveWorkbook.Save
End Sub






Thanks for your help

Cheers
Arvind

[mdmackillop]

Hi
You should consider splitting your code into separate sub routines. These can be called from a main sub. eg

Sub Main()
Call ErrorCheck
Call CopyAndPasteData
Call PivotAnd Format
'ans so on
End Sub

That way it is easier to test for errors, to make changes and debug your code.

[aravindhan_3]

H,

Thanks for your suggestion I have amended the code accordingly

Thanks for you help
Arvind