Hi Asa,
Thanks for testing the code. I always use arrays. Application.counta and
index would work on arrays just like worksheet function works in ranges.
Anyway I converted those variant array into a range.
Can you please test this one for me ?
Sub kTest_v2()
Dim ka As Range, k(), i As Long, n As Long, c As Long
Dim j As Long, Flg As Boolean, dRun As Date
Dim iFlg As Boolean, fCode1 As String, fCode2 As String
Dim dFlg As Boolean, meDate As String, FC As Range, Cnt As Long
Dim wksOriginal As Worksheet, wksResult As Worksheet
Set wksOriginal = Worksheets("Original")
Set ka = wksOriginal.UsedRange.Resize(, 17)
'MsgBox UBound(ka, 1)
ReDim k(1 To ka.Rows.Count, 1 To 17)
For i = 1 To ka.Rows.Count
If InStr(1, ka.Cells(i, 1).Value, "total stock", vbTextCompare)
Then Exit For
If Not dFlg Then
If Len(ka.Cells(i, 1).Value) Then
If InStr(1, ka.Cells(i, 1).Value, "Date Run") Then
dRun = ka.Cells(i, 3).Value: meDate = ka.Cells(i,
7).Value
dFlg = True
End If
If dFlg Then
j = i + 1
Do
Set FC = Application.WorksheetFunction.Index(ka, j,
0)
Cnt = Application.WorksheetFunction.CountA(FC)
If Cnt = 2 Then
fCode1 = ka.Cells(j, 1).Value: fCode2 =
ka.Cells(j, 2).Value
iFlg = True: GoTo First
End If
If iFlg Then
If Cnt > 10 Then
n = n + 1
k(n, 1) = dRun: k(n, 2) = meDate
k(n, 3) = fCode1: k(n, 4) = fCode2
k(n, 5) = ka.Cells(j, 1).Value: k(n, 6) =
ka.Cells(j, 2).Value
k(n, 7) = ka.Cells(j, 6).Value: k(n, 8) =
ka.Cells(j, 8).Value
For c = 9 To ka.Columns.Count
k(n, c) = ka.Cells(j, c).Value
Next
End If
End If
First:
j = j + 1: i = j
Loop Until ka.Cells(j, 1).Value = "Stock for Fruit code"
iFlg = False
End If
End If
Else
j = i + 1
Do
Set FC = Application.WorksheetFunction.Index(ka, j, 0)
Cnt = Application.WorksheetFunction.CountA(FC)
If Cnt = 2 Then
fCode1 = ka.Cells(j, 1).Value: fCode2 = ka.Cells(j,
2).Value
iFlg = True: GoTo Second
End If
If iFlg Then
If Cnt > 10 Then
n = n + 1
k(n, 1) = dRun: k(n, 2) = meDate
k(n, 3) = fCode1: k(n, 4) = fCode2
k(n, 5) = ka.Cells(j, 1).Value: k(n, 6) =
ka.Cells(j, 2).Value
k(n, 7) = ka.Cells(j, 6).Value: k(n, 8) =
ka.Cells(j, 8).Value
For c = 9 To ka.Columns.Count
k(n, c) = ka.Cells(j, c).Value
Next
End If
End If
Second:
j = j + 1: i = j
If j = ka.Rows.Count Then Exit Do
Loop Until ka.Cells(j, 1).Value = "Stock for Fruit code"
iFlg = False
End If
Next
If n Then
On Error Resume Next
Set wksResult = Worksheets("Result")
If Err.Number <> 0 Then
Err.Clear
Set wksResult = Worksheets.Add
ActiveSheet.Name = "Result"
End If
On Error GoTo 0
With wksResult
.UsedRange.Offset(5).ClearContents
.Range("a1") = "Summary of Monthly Fruit Sales"
.Range("a2") = "Waynes Fruit Store"
.Range("a4").Resize(, 17) = Array("Date Run :", "Month Ending
Date", "Code", "", "Fruit Number", "Fruit", _
"Fruit Code", "Register Digit Code",
"Current", "Extra.", "Total", "Month", _
"Extra", "Total", "Year", "Extra", "Total")
.Range("a5").Resize(n, 17) = k
.Range("a5").Resize(, 17).EntireColumn.AutoFit
End With
End If
End Sub
Thanks
Kris
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com
