Can anyone help me with a Formula in VB/excel to COUNT how many numbers are consecutive
within a Row that spans 20 Columns?
Example:
65 67 68 69 75 79 80 84 85 90 78 73 61 93 92 91 95 6 33 99
The answer to the above example should be a Count of 11.
In order to illustrate what I mean to say that I require a total count of the
individual numbers that make up the consecutive. In the example above, we do the counting in this way: So, rather than 67/68 = 1
or 79/80 = 1.
I need 90 93, 92, 91 = 4
67,68,69 = 3
79,80 = 2
84,85 = 2
---
Total Count = 11
Is there a way that a Formula can be put together to count the above and to get the correct answer.
I'd like to this for an extremely large number list for each line, individually, in a spreadsheet like excel.
Regards, Tasmanian Devil
8 5326
Is there someone in this forum that would like to share knowledge in helping to solve this puzzle?
I'm looking forward to receiving good news.
How :
- put the data in an array
- sort line by line
- find consecutive numbers
- dump data in sheet
This is the code for creating and sorting the array: - Public Sub Count()
-
Dim ARRdata() As Variant
-
Dim ARRdataROWidx As Integer
-
Dim ARRdataCOLidx As Integer
-
Dim ARRtemp(1 To 20) As Integer
-
Sheets("data").Select
-
ARRdata = Range("A1").Resize(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)
-
For ARRdataROWidx = LBound(ARRdata, 1) To UBound(ARRdata, 1)
-
For ARRdataCOLidx = 1 To 20
-
ARRtemp(ARRdataCOLidx) = ARRdata(ARRdataROWidx, ARRdataCOLidx)
-
Next
-
Call Sort_Array(ARRtemp)
-
For ARRdataCOLidx = 1 To 20
-
ARRdata(ARRdataROWidx, ARRdataCOLidx) = ARRtemp(ARRdataCOLidx)
-
Next
-
Next
-
...
-
'count consecutive numbers
-
...
-
'dump to ...
-
...
-
End Sub
-
-
Public Function Sort_Array(ByRef THEarray As Variant)
-
Dim TEMP As Variant
-
Dim X As Integer
-
Dim SORTED As Boolean
-
SORTED = False
-
Do While Not SORTED
-
SORTED = True
-
For X = 1 To UBound(THEarray) - 1
-
If THEarray(X) > THEarray(X + 1) Then
-
TEMP = THEarray(X + 1)
-
THEarray(X + 1) = THEarray(X)
-
THEarray(X) = TEMP
-
SORTED = False
-
End If
-
Next X
-
Loop
-
End Function
many thanks for your help but your formula displays an error message: it isn't possible for Visual Basic to determine which action to be performed.
And it says that the possible causes are: there is syntax error: punctuation or the data inputed are wrong and it isn't work out.
In vb the script stops:
an yellow arrow points here: Public Sub Count()
and only these 3 points [...] are marked in red
Next
Next ...
'count consecutive numbers ...
'dump to ... ...
End Sub
This is normal because it's the place where the code for the calculation must be placed.
In Your call You are giving the example and say it must be 11 ??? not 12 ???
65 67 68 69 75 79 80 84 85 90 78 73 61 93 92 91 95 6 33 99
67 68 69 79 80 84 85 90 78 93 92 91 = 12 !
the code for calculating = - Public Sub COUNT()
-
Dim ARRdata() As Variant
-
Dim ARRdataROW As Integer
-
Dim ARRdataCOL As Integer
-
Dim ARRtemp(1 To 20) As Integer
-
Dim FIRST As Boolean
-
Dim COUNT As Integer
-
Dim ARRresults() As Integer
-
'§ load and sort
-
Sheets("data").Select
-
ARRdata = Range("A1").Resize(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)
-
ReDim ARRresults(LBound(ARRdata, 1) To UBound(ARRdata, 1))
-
For ARRdataROW = LBound(ARRdata, 1) To UBound(ARRdata, 1)
-
For ARRdataCOL = 1 To 20
-
ARRtemp(ARRdataCOL) = ARRdata(ARRdataROW, ARRdataCOL)
-
Next
-
Call Sort_Array(ARRtemp)
-
For ARRdataCOL = 1 To 20
-
ARRdata(ARRdataROW, ARRdataCOL) = ARRtemp(ARRdataCOL)
-
Next
-
'§ count
-
FIRST = True
-
COUNT = 0
-
For ARRdataCOL = 1 To 19
-
If ARRdata(ARRdataROW, ARRdataCOL) + 1 = ARRdata(ARRdataROW, ARRdataCOL + 1) Then
-
If FIRST Then
-
COUNT = COUNT + 2
-
Else
-
COUNT = COUNT + 1
-
End If
-
FIRST = False
-
Else
-
FIRST = True
-
End If
-
Next
-
ARRresults(ARRdataROW) = COUNT
-
Next
-
'§ dump
-
Range("A20").Resize(UBound(ARRdata, 1), 20) = ARRdata
-
Range("V20").Resize(UBound(ARRresults), 1) = ARRresults
-
End Sub
I have dumped the results in A20... and V20...
If You want to see the results elsewhere, please change the code.
Sorry, there is an error in the code for ARRresults. - Public Sub COUNT()
-
Dim ARRdata() As Variant
-
Dim ARRdataROW As Integer
-
Dim ARRdataCOL As Integer
-
Dim ARRtemp(1 To 20) As Integer
-
Dim FIRST As Boolean
-
Dim COUNT As Integer
-
Dim ARRresults() As Integer
-
'§ load and sort
-
Sheets("data").Select
-
ARRdata = Range("A1").Resize(Range("A1").End(xlDown).Row, Range("A1").End(xlToRight).Column)
-
ReDim ARRresults(LBound(ARRdata, 1) To UBound(ARRdata, 1), 1 To 1)
-
For ARRdataROW = LBound(ARRdata, 1) To UBound(ARRdata, 1)
-
For ARRdataCOL = 1 To 20
-
ARRtemp(ARRdataCOL) = ARRdata(ARRdataROW, ARRdataCOL)
-
Next
-
Call Sort_Array(ARRtemp)
-
For ARRdataCOL = 1 To 20
-
ARRdata(ARRdataROW, ARRdataCOL) = ARRtemp(ARRdataCOL)
-
Next
-
'§ count
-
FIRST = True
-
COUNT = 0
-
For ARRdataCOL = 1 To 19
-
If ARRdata(ARRdataROW, ARRdataCOL) + 1 = ARRdata(ARRdataROW, ARRdataCOL + 1) Then
-
If FIRST Then
-
COUNT = COUNT + 2
-
Else
-
COUNT = COUNT + 1
-
End If
-
FIRST = False
-
Else
-
FIRST = True
-
End If
-
Next
-
ARRresults(ARRdataROW, 1) = COUNT
-
Next
-
'§ dump
-
Range("A20").Resize(UBound(ARRdata, 1), 20) = ARRdata
-
Range("V20").Resize(UBound(ARRresults), 1) = ARRresults
-
End Sub
I think best way is to copy whole row in a new empty row or better in a new sheet at first row. arrange it in ascending order (by formula), now check each column one by one from first column in first row if its value is 1 more than previous, then increment the counter. Thats the result. For other rows of data do same thing.
the last code that you provided isn't working. In vba some lines are appearing in red:
Dim*ARRdata()*As*Variant
Dim*ARRtemp(1*To*20)*As*Integer
Dim*ARRresults()*As*Integer
ReDim*ARRresults(LBound(ARRdata,*1)*To*UBound(ARRd ata,*1),*1*To*1)
***For*ARRdataROW*=*LBound(ARRdata,*1)*To*UBound(A RRdata,*1)
*ARRtemp(ARRdataCOL)*=*ARRdata(ARRdataROW,*ARRdata COL)
**************ARRdata(ARRdataROW,*ARRdataCOL)*=*AR Rtemp(ARRdataCOL)
If*ARRdata(ARRdataROW,*ARRdataCOL)*+*1*=*ARRdata(A RRdataROW,*ARRdataCOL*+*1)*Then
************If*FIRST*Then
ARRresults(ARRdataROW,*1)*=*COUNT
***
***Range("A20").Resize(UBound(ARRdata,*1),*20)*=*A RRdata
***Range("V20").Resize(UBound(ARRresults),*1)*=*AR Rresults
and excel isn't reconignizing that
there's a macro of this code.
merci beaucoup en avance
I'm using Excel 2003 and the macro runs without a problem.
(see attachment)
If Your using an other version maybe You have to translate this code to the new version.
Sign in to post your reply or Sign up for a free account.
Similar topics |
by: ishekara |
last post by:
Hi all,
An object of a class A which has no member variables and no member
functions, still the size of the object is 1 byte, if there is a byte member
variable then also the size of the object...
|
by: marktang |
last post by:
ONU (Optical Network Unit) is one of the key components for providing high-speed Internet services. Its primary function is to act as an endpoint device located at the user's premises. However,...
|
by: Hystou |
last post by:
Most computers default to English, but sometimes we require a different language, especially when relocating. Forgot to request a specific language before your computer shipped? No problem! You can...
|
by: Hystou |
last post by:
Overview:
Windows 11 and 10 have less user interface control over operating system update behaviour than previous versions of Windows. In Windows 11 and 10, there is no way to turn off the Windows...
|
by: tracyyun |
last post by:
Dear forum friends,
With the development of smart home technology, a variety of wireless communication protocols have appeared on the market, such as Zigbee, Z-Wave, Wi-Fi, Bluetooth, etc. Each...
| |
by: agi2029 |
last post by:
Let's talk about the concept of autonomous AI software engineers and no-code agents. These AIs are designed to manage the entire lifecycle of a software development project—planning, coding, testing,...
|
by: isladogs |
last post by:
The next Access Europe User Group meeting will be on Wednesday 1 May 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM).
In this session, we are pleased to welcome a new...
|
by: conductexam |
last post by:
I have .net C# application in which I am extracting data from word file and save it in database particularly. To store word all data as it is I am converting the whole word file firstly in HTML and...
|
by: adsilva |
last post by:
A Windows Forms form does not have the event Unload, like VB6. What one acts like?
|
by: muto222 |
last post by:
How can i add a mobile payment intergratation into php mysql website.
| |