vba match diagonal value againt range

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
984
Office Version
  1. 2010
Platform
  1. Windows
Hello everyone
After searching here, I found some post here about palindromic algorithm, but those do not fit in the idea I am looking for.
The close code to the idea I am working on, is this code:
VBA Code:
Sub SelectDiagonal()
         Dim myRange As Range
         Set myRange = ActiveSheet.Range("A4").CurrentRegion
         Dim a As Long, b As Long, c As Long, d As Long, i As Long
                  a = myRange.Row()
                  b = myRange.Column()
                  c = myRange.Rows.Count
                  d = myRange.Columns.Count
                           Dim Rng As Range
                           Set Rng = Cells(a + c - 1, b)
                           For i = 1 To c - 1
                           Set Rng = Union(Rng, Cells(a + c - 1 - i, b + i))
                           Next
                           Rng.Select
End Sub

But the only thing I get from here is just to select some cells on diagonal. Then I write a low-level code as illustration on what I am trying to accomplish
So this is my try:

VBA Code:
Option Explicit
Sub Palindro_mic()
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer
Dim f As Integer, g As Integer, h As Integer, i As Integer, j As Integer, k As Integer, L As Integer

a = Range("B3").Value
b = Range("B2").Value
         If a = b Then
         Range("I2").Value = 1
         Else
         Range("I2").Value = 0
End If

c = Range("C4").Value
d = Range("C2").Value
         If c = d Then
         Range("J2").Value = 1
         Else
         Range("J2").Value = 0
End If

e = Range("D5").Value
f = Range("D2").Value
      If e = f Then
      Range("K2").Value = 1
      Else
      Range("K2").Value = 0
End If

g = Range("E6").Value
h = Range("E2").Value
      If g = h Then
      Range("L2").Value = 1
      Else
      Range("L2").Value = 0
End If

i = Range("F7").Value
j = Range("F2").Value
         If i = j Then
         Range("M2").Value = 1
         Else
         Range("M2").Value = 0
End If

k = Range("G8").Value
L = Range("G2").Value
         If k = L Then
         Range("N2").Value = 1
         Else
         Range("N2").Value = 0
End If

End Sub
for illustration (not able to download xl2bb, sorry) this is what a good looping code will generate
1590635854030.png

the range B2:G2 is compare against the diagonal B3,C4,D5,E6,F7,G8 and if any value is equal then on the range I:N will show the results if any match equal 1 else 0
what I expect is go to the LastRow in myArray.
Please any possible help?
Thank you for reading this post.
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
the range B2:G2 is compare against the diagonal B3,C4,D5,E6,F7,G8

Then compare the same D2:G2 range with B4,C5,D6,E7,F8,G9
Or
Then compare D3:G3 range with B4,C5,D6,E7,F8,G9

If it's the first option, try the following:

VBA Code:
Sub vba_match_diagonal()
  Dim c As Range, i As Long, j As Long
  
  For i = 3 To Range("B" & Rows.Count).End(3).Row
    j = i
    For Each c In Range("B2:G2")
      c.Offset(i - 3, 7).Value = (c.Value = Cells(j, c.Column).Value) * -1
      j = j + 1
    Next c
  Next i
End Sub

This is the result with some examples:
Dante Amor
ABCDEFGHIJKLMNO
1legsupperlowerarmthigneck
2425186254436534408001101
3218191259441539413000000
4408183264446544418100000
5425485254451549423100100
6425301264436554428010100
7433179226303428433000000
8364186231387226408000000
9480178236436296251000000
10265441241436301255
11
Hoja10
 
Upvote 0
DanteAmor thank you, Good observation, you are right; and sorry about that.
I wasn't clear about the condition, the first line work and not the rest so I make a table, with what I expect.

(NOTE:This DYNAMIC array at the moment is ("B2:G2744"))
1590661891095.png

And again Thank you DanteAmor for you help.
 
Upvote 0
Try this

VBA Code:
Sub vba_match_diagonal()
  Dim i As Long, k As Long
  Dim a As Variant, b As Variant
  
  a = Range("B2", Range("G" & Rows.Count).End(3)(7)).Value2
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  
  For i = 1 To UBound(a, 1) - 6
    For k = 1 To UBound(a, 2)
      b(i, k) = (a(i, k) = a(i + k, k)) * -1
    Next k
  Next i
  Range("I2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub
 
Upvote 0
DanteAmor the Great, awesome, thank you so much, whenever You publish a book, I will buy ASAP.
Your Code work PERFECT.
 
Upvote 0
I'm glad to help you. Thanks for the compliment. ?
 
Upvote 0

Forum statistics

Threads
1,215,446
Messages
6,124,900
Members
449,194
Latest member
JayEggleton

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top