Hi Kris, Works fine!
I think .Index worked ok on the array, and a quick test with .Count seemed to work. I wonder if .CountA has a bug in Excel 2010 when it comes to arrays. Asa From: excel-macros@googlegroups.com [mailto:excel-macros@googlegroups.com] On Behalf Of Kris Sent: Thursday, January 05, 2012 9:02 AM To: excel-macros@googlegroups.com Subject: $$Excel-Macros$$ Re: Test XL 2007 code on XL 2010 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 -- 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
