Option Explicit
Public Sub agp_arnelgp()
Const NAME_COLUMN As Integer = 5
Const CODE_COLUMN As Integer = 4
Const ADDRESS_COLUMN As Integer = 3
Const CREDITOR_COLUMN As Integer = 12
Const DEBTOR_COLUMN As Integer = 13
Const FIRST_CASE_COLUMN As Integer = 10
Const SECOND_CASE_COLUMN As Integer = 11
Dim oXml As Object
Dim oRst As Object
Dim oRng As Range
Dim rw As Long
Dim var As Variant, sValue As String
Dim whl As Variant, dec As Variant, pos As Integer
Dim line1 As Long, row1 As Long
Dim Criteria As String, Cnt As Integer, i As Integer, j As Integer
With Worksheets("SOURCE")
'the Columns are A upto N
Set oRng = .Range("A7:N" & .Cells(8, 1).End(xlDown).Row)
End With
Set oRst = CreateObject("ADODB.Recordset")
Set oXml = CreateObject("MSXML2.DOMDocument")
oXml.LoadXML oRng.Value(xlRangeValueMSPersistXML)
oRst.Open oXml
'count how many records to loop
With oRst
Do While Not .EOF
If UCase(.Fields(FIRST_CASE_COLUMN) & .Fields(SECOND_CASE_COLUMN)) = "YEXCELLENT" Then
Cnt = Cnt + 1
Else
Exit Do
End If
.MoveNext
Loop
End With
With oRst
.Filter = "[" & .Fields(10).Name & "]='Y' And [" & .Fields(11).Name & "]='Excellent'"
line1 = 18: row1 = 0
For i = 1 To Cnt
.MoveFirst
If i > 1 Then
For j = 2 To i
.MoveNext
Next
End If
Do While Not .EOF
line1 = line1 + 1: row1 = row1 + 1
If row1 Mod 28 = 0 Then
Sheets("Template").Select
ActiveWindow.SmallScroll Down:=-15
Range("A17:G46").Select
Selection.Copy
Sheets("expected for a successful").Select
Range("A" & line1 + 1).Select
ActiveSheet.Paste
Sheets("expected for a successful").HPageBreaks.Add Before:=Cells(line1 + 1, 1)
line1 = line1 + 3
row1 = 1
End If
With Worksheets("expected for a successful")
.Cells(line1, 1) = oRst(NAME_COLUMN) & ""
.Cells(line1, 2) = oRst(CODE_COLUMN) & ""
.Cells(line1, 3) = oRst(ADDRESS_COLUMN) & ""
whl = 0
dec = 0
sValue = oRst(CREDITOR_COLUMN) & ""
pos = InStr(1, sValue, ".")
whl = Val(sValue)
dec = 0
If pos <> 0 Then
dec = Mid$(sValue, pos)
whl = Val(Replace$(sValue, dec, ""))
dec = Val(Replace$(dec, ".", ""))
End If
If dec <> 0 Then
.Cells(line1, 4) = dec
End If
If whl <> 0 Then
.Cells(line1, 5) = whl
End If
whl = 0
dec = 0
sValue = oRst(DEBTOR_COLUMN) & ""
pos = InStr(1, sValue, ".")
whl = Val(sValue)
dec = 0
If pos <> 0 Then
dec = Mid$(sValue, pos)
whl = Val(Replace$(sValue, dec, ""))
dec = Val(Replace$(dec, ".", ""))
End If
If dec <> 0 Then
.Cells(line1, 6) = dec
End If
If whl <> 0 Then
.Cells(line1, 7) = whl
End If
End With
For j = 1 To Cnt
.MoveNext
If .EOF Then
Exit For
End If
Next
Loop
Next
.Filter = "[" & .Fields(10).Name & "]<>'Y' And [" & .Fields(11).Name & "]='Excellent'"
line1 = 18: row1 = 0
For i = 1 To Cnt
.MoveFirst
If i > 1 Then
For j = 2 To i
.MoveNext
Next
End If
Do While Not .EOF
line1 = line1 + 1: row1 = row1 + 1
If row1 Mod 28 = 0 Then
Sheets("Template").Select
ActiveWindow.SmallScroll Down:=-15
Range("A17:G46").Select
Selection.Copy
Sheets("expected for a Unsuccessful").Select
Range("A" & line1 + 1).Select
ActiveSheet.Paste
Sheets("expected for a Unsuccessful").HPageBreaks.Add Before:=Cells(line1 + 1, 1)
line1 = line1 + 3
row1 = 1
End If
With Worksheets("expected for a Unsuccessful")
.Cells(line1, 1) = oRst(NAME_COLUMN) & ""
.Cells(line1, 2) = oRst(CODE_COLUMN) & ""
.Cells(line1, 3) = oRst(ADDRESS_COLUMN) & ""
whl = 0
dec = 0
sValue = oRst(CREDITOR_COLUMN) & ""
pos = InStr(1, sValue, ".")
whl = Val(sValue)
dec = 0
If pos <> 0 Then
dec = Mid$(sValue, pos)
whl = Val(Replace$(sValue, dec, ""))
dec = Val(Replace$(dec, ".", ""))
End If
If dec <> 0 Then
.Cells(line1, 4) = dec
End If
If whl <> 0 Then
.Cells(line1, 5) = whl
End If
whl = 0
dec = 0
sValue = oRst(DEBTOR_COLUMN) & ""
pos = InStr(1, sValue, ".")
whl = Val(sValue)
dec = 0
If pos <> 0 Then
dec = Mid$(sValue, pos)
whl = Val(Replace$(sValue, dec, ""))
dec = Val(Replace$(dec, ".", ""))
End If
If dec <> 0 Then
.Cells(line1, 6) = dec
End If
If whl <> 0 Then
.Cells(line1, 7) = whl
End If
End With
For j = 1 To Cnt
.MoveNext
If .EOF Then
Exit For
End If
Next
Loop
Next
.Close
End With
Set oRst = Nothing
Set oXml = Nothing
Set oRng = Nothing
End Sub
Would appreciate if you can have a look....Thank you Sir