Consecutive or Adjacent Values

  • Thread starter Thread starter Susan
  • Start date Start date
S

Susan

Hello newsgroup,

I have a number of cells and rows of data. Most of the
cells have a zero value. And, there are many instances
where the non-zero values are consecutive in a row, or
adjacent in a column. For example,

0,0,0,4,5,0,0,0
0,2,0,0,0,0,0,0
0,2,0,4,5,0,7,8

I would like a formula(s) that would tell me:

A) how many times do consecutive values come up? In this
case:

4-5 comes up 2 times
7-8 comes up 1 time

B) how many times do adjacent column values come up? In
this case:

2-2 comes up 1 time

Any help would be great. Thank you in advance.

Susan
 
Susan,

Not a formula, but a macro: select a single cell in your table, which must
have at least one blank column ot the right and one blank row below, then
run the macro below. The data could also be written to a range as easily.

My assumption was that you only have single digit integers in your array.
You can change that by modifying the code to expand the array: simply change
all instances of 8 to a value of one less than your highest interger value
(though you may run into some internal Excel limits if that is too high).
If you need to do that change and have trouble, post back.

HTH,
Bernie
MS Excel MVP

Sub ShowSusanHerConsOrAdjValues()
Dim myRange As Range
Dim myCell As Range
Dim myArray(1 To 2, 1 To 8) As Integer
Dim i As Integer
Dim j As Integer
Dim strResp As String

For i = 1 To 2
For j = 1 To 8
myArray(i, j) = 0
Next j
Next i

Set myRange = ActiveCell.CurrentRegion

For Each myCell In myRange
If myCell.Value <> 0 Then
If myCell(1, 2).Value = myCell.Value + 1 Then
myArray(1, myCell.Value) = myArray(1, myCell.Value) + 1
End If
If myCell(2, 1).Value = myCell.Value + 1 Then
myArray(1, myCell.Value) = myArray(1, myCell.Value) + 1
End If
If myCell(1, 2).Value = myCell.Value Then
myArray(2, myCell.Value) = myArray(2, myCell.Value) + 1
End If
If myCell(2, 1).Value = myCell.Value Then
myArray(2, myCell.Value) = myArray(2, myCell.Value) + 1
End If
End If
Next myCell

strResp = "Hey Susan, the answer is:"
For j = 1 To 8
If myArray(1, j) <> 0 Then
strResp = strResp & Chr(10) & j & "-" & j + 1 & ": " & myArray(1, j) & "
times"
End If
Next j
For j = 1 To 8
If myArray(2, j) <> 0 Then
strResp = strResp & Chr(10) & j & "-" & j & ": " & myArray(2, j) & " times"
End If
Next j

MsgBox strResp

End Sub
 
I made a mistake in my previous post: I forgot about pairs of 9s. So, use
this version, below. If you have integers greater than 9, simply change all
instances of 9 in the code below to the highest value you expect.

HTH,
Bernie
MS Excel MVP

Sub ShowSusanHerConsOrAdjValues()
Dim myRange As Range
Dim myCell As Range
Dim myArray(1 To 2, 1 To 9) As Integer
Dim i As Integer
Dim j As Integer
Dim strResp As String

For i = 1 To 2
For j = 1 To 9
myArray(i, j) = 0
Next j
Next i

Set myRange = ActiveCell.CurrentRegion

For Each myCell In myRange
If myCell.Value <> 0 Then
If myCell(1, 2).Value = myCell.Value + 1 Then
myArray(1, myCell.Value) = myArray(1, myCell.Value) + 1
End If
If myCell(2, 1).Value = myCell.Value + 1 Then
myArray(1, myCell.Value) = myArray(1, myCell.Value) + 1
End If
If myCell(1, 2).Value = myCell.Value Then
myArray(2, myCell.Value) = myArray(2, myCell.Value) + 1
End If
If myCell(2, 1).Value = myCell.Value Then
myArray(2, myCell.Value) = myArray(2, myCell.Value) + 1
End If
End If
Next myCell

strResp = "Hey Susan, the answer is:"
For j = 1 To 9
If myArray(1, j) <> 0 Then
strResp = strResp & Chr(10) & j & "-" & j + 1 & _
": " & myArray(1, j) & " times"
End If
Next j
For j = 1 To 9
If myArray(2, j) <> 0 Then
strResp = strResp & Chr(10) & j & "-" & j & _
": " & myArray(2, j) & " times"
End If
Next j

MsgBox strResp

End Sub
 
Thank you Bernie,

I am a bit lost with the programming language. I am sure
it is not as simple is typing this into the cell. How do I
execute the program that you detailed? thanks again,

S
 
Susan,

Copy the code, then go to Excel and use Alt-F11 to enter the VBEditor. Use
Ctrl-R to open the project explorer, and select your workbook. Then use
Insert | Module, and paste the code into the window that appears.

Go back to Excel and save your workbook. Then select a cell in your table,
then choose Tools | macro | macros.... and select This workbook from the
"Macros in" dropdown, then select the macro ShowSusanHerConsOrAdjValues and
press Run. You can also assign the macro to a custom commandbar button or a
button on your sheet.

If you have problems doing this, I will send you a working example workbook
with the macro assigned to a button on the sheet.

HTH,
Bernie
MS Excel MVP
 
Bernie,

I was getting 'subscript out of range' error, but finally
got it to work (had to do with max value) - Thank you! One
last thing - if you get a chance...

The data that it gives back is rather lengthy (the message
box goes off the page). Is there a way to send this data
to another sheet or a text file or something. Thanks again
for any ideas...

S
-----Original Message-----
Susan,

Copy the code, then go to Excel and use Alt-F11 to enter the VBEditor. Use
Ctrl-R to open the project explorer, and select your workbook. Then use
Insert | Module, and paste the code into the window that appears.

Go back to Excel and save your workbook. Then select a cell in your table,
then choose Tools | macro | macros.... and select This workbook from the
"Macros in" dropdown, then select the macro
Click to expand...
ShowSusanHerConsOrAdjValues and
 
Susan,

We can send the data anywhere you want. What is your preference: an Excel
File, a new sheet within the old file, or a text file?

HTH,
Bernie
MS Excel MVP
 
Susan,

Use this version, after making changed where indicated.

HTH,
Bernie
MS Excel MVP

Sub ReportSusansConsOrAdjValues()
Dim myRange As Range
Dim myCell As Range
Dim mySh As Worksheet
Dim myArray(1 To 2, 1 To 9) As Integer
Dim i As Integer
Dim j As Integer
Dim strResp As String

For i = 1 To 2
For j = 1 To 9
myArray(i, j) = 0
Next j
Next i

Set myRange = ActiveCell.CurrentRegion

For Each myCell In myRange
If myCell.Value <> 0 Then
If myCell(1, 2).Value = myCell.Value + 1 Then
myArray(1, myCell.Value) = myArray(1, myCell.Value) + 1
End If
If myCell(2, 1).Value = myCell.Value + 1 Then
myArray(1, myCell.Value) = myArray(1, myCell.Value) + 1
End If
If myCell(1, 2).Value = myCell.Value Then
myArray(2, myCell.Value) = myArray(2, myCell.Value) + 1
End If
If myCell(2, 1).Value = myCell.Value Then
myArray(2, myCell.Value) = myArray(2, myCell.Value) + 1
End If
End If
Next myCell


'Change the name to the sheet where you want the report
Set mySh = Worksheets("Sheet1")
'Change the D1 to the cell address you want the report to start in
'The report will be two columns wide
Set myCell = mySh.Range("D1")

myCell.Value = "Values"
myCell(1, 2).Value = "Count"
Set myCell = myCell(2)

For j = 1 To 9
If myArray(1, j) <> 0 Then
myCell.Value = "'" & j & "-" & j + 1
myCell(1, 2).Value = myArray(1, j)
Set myCell = myCell(2)
End If
Next j
For j = 1 To 9
If myArray(2, j) <> 0 Then
myCell.Value = "'" & j & "-" & j
myCell(1, 2).Value = myArray(2, j)
Set myCell = myCell(2)
End If
Next j


End Sub
 
Susan,

Nobody pays us, though some MVPs do have consulting businesses, and find
that posting answeres makes good business sense. Generally, we -or, at least
I - do this because I like working with Excel and I want to keep my skills
sharp. I treat posts as puzzles, since I like a challenge, and I enjoy the
interaction. And the infrequent reply of profuse thanks makes it
worthwhile - there are some people who I helped who just bypass the
newsgroups and contact me, always friendly and nice to talk with.....

Bernie
MS Excel MVP
 
Well I will remember that. Your help has been invaluable!
Thanks Bernie. Talk to you soon...

S
 
Back
Top