Loop to compare Cells in a Column

[KORKIS2]

So I want to go down a column and compare cells.
I know alot of C programming but not much VBA.

So here is a flow of what I want.
Lets Say

Basically keep looping and working down the Column until the next spot it larger than previous then exit the loop.



P= blank array
X= Cell Value A1
Y= Cell A2

IF X <Y Then
Y stored in P exit
Else Y+1 =Y(Meaning A3)
Return to IF

Basically keep looping and working down the Column until the next spot it larger than previous then exit the loop.

 

[KORKIS2]

No I don't think that will work because this has got to be set up so that people can fill out this document and then just click something for the macro to work I appreciate your help though.

 

[KORKIS2]

What about if you just wrote a code to compare each cell in the column to A1 and if doesn't equal A1 then try the next cell in the column and if it does save the cell number A4.... or w.e the correct cell destination is?

 

[ChrisM]

Yes, you can code this, I always try to find a non-VBA solution first though.

Here's the code. You are going to have to modify it a little bit, because I assumed your data starts in row 1. I'm also outputting the results to D1 which probably needs to change.

Sub GetRows()

Dim lLastRow As Long
Dim aSrc As Variant
Dim aResults() As String   'item, start row, stop row
Dim i As Long, k As Long
Dim sCurrVal As String

lLastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

aSrc = Sheet1.Range("A1:A" & lLastRow) 'this is your raw data

sCurrVal = aSrc(1, 1) 'set current item
ReDim aResults(1 To 3, 1 To 1) 'create result array
aResults(1, 1) = sCurrVal
aResults(2, 1) = 1 'assumes your data starts in row 1

k = 1 'result counter
 
For i = 1 To UBound(aSrc, 1)
    If aSrc(i, 1) <> sCurrVal Then
        'write stop row value
        aResults(3, k) = i - 1
        'set new search item
        sCurrVal = aSrc(i, 1)
        'load result array
        k = k + 1
        ReDim Preserve aResults(1 To 3, 1 To k)
        aResults(1, k) = sCurrVal
        aResults(2, k) = i
    End If
Next i

'now write result array to worksheet in 3 columns
Sheet1.Range("D1").Resize(k, 3) = Application.Transpose(aResults)

End Sub

 

[KORKIS2]

I appreciate the help
sadly nothing shows up in D1

The date starts a A7 I changed that

 

[ChrisM]

you have to change a little more than that, try this one:

Sub GetRows()

Dim lLastRow As Long
Dim aSrc As Variant
Dim aResults() As String   'item, start row, stop row
Dim i As Long, k As Long
Dim sCurrVal As String

lLastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

aSrc = Sheet1.Range("A7:A" & lLastRow) 'this is your raw data

sCurrVal = aSrc(1, 1) 'set current item
ReDim aResults(1 To 3, 1 To 1) 'create result array
aResults(1, 1) = sCurrVal
aResults(2, 1) = 7 'assumes your data starts in row 1

k = 1 'result counter
 
For i = 1 To UBound(aSrc, 1)
    If aSrc(i, 1) <> sCurrVal Then
        'write stop row value
        aResults(3, k) = i + 5
        'set new search item
        sCurrVal = aSrc(i, 1)
        'load result array
        k = k + 1
        ReDim Preserve aResults(1 To 3, 1 To k)
        aResults(1, k) = sCurrVal
        aResults(2, k) = i + 6
    End If
Next i
aResults(3, k) = i + 6 'this will capture the last entry

'now write result array to worksheet in 3 columns
Sheet1.Range("D1").Resize(k, 3) = Application.Transpose(aResults)

End Sub

 

[KORKIS2]

Show I changed the sheet name and used the corrected version you gave me I really appreciate your time and help is there anything I could do to get this working?

 

[ChrisM]

You're not giving much detail on what's wrong. I've tested it and it runs. What are you seeing when you run the code?

 

[KORKIS2]

I apologize when I click it nothing happens at all

Here is the list of Frequencies in Column A starting at A7
What else could help you I apologize I'm new to this and dont even know the questions to ask or information that would help?
Thank you for your time and patience.

799.0125
799.0125
802.0125
804.9875
851.0125
851.0125
860.0125
860.0125
860.0125
860.0125
860.0125
868.9875
868.9875

<tbody>
</tbody>

 

[ChrisM]

Please post the code you are Running, the worksheet name, and explain how you are launching/running the code

 

[KORKIS2]

I changed the sheet name to Sheet1 like you had in yours I am launching it through going into VIEW then macros then calling mac9

Sub mac9()
Dim lLastRow As Long                  '/// A long Variable stores a value between -2,147,483,648 -2,147,483,647\\\\\
Dim aSrc As Variant                   '/// A Variant is a special data type that can contain any kind of data except fixed-length String data. \\\\\
Dim aResults() As String              '///item, start row, stop row\\\\
Dim i As Long, k As Long               '/// A long Variable stores a value between -2,147,483,648 -2,147,483,647\\\\\
Dim sCurrVal As String


lLastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row


aSrc = Sheet1.Range("A8:A" & lLastRow)          'this is your raw data


sCurrVal = aSrc(1, 1) 'set current item
ReDim aResults(1 To 3, 1 To 1) 'create result array
aResults(1, 1) = sCurrVal
aResults(2, 1) = 7 'assumes your data starts in row 1


k = 1 'result counter
 
For i = 1 To UBound(aSrc, 1)
    If aSrc(i, 1) <> sCurrVal Then
        'write stop row value
        aResults(3, k) = i + 5
        'set new search item
        sCurrVal = aSrc(i, 1)
        'load result array
        k = k + 1
        ReDim Preserve aResults(1 To 3, 1 To k)
        aResults(1, k) = sCurrVal
        aResults(2, k) = i + 6
    End If
Next i
aResults(3, k) = i + 6 'this will capture the last entry


'now write result array to worksheet in 3 columns
Sheet1.Range("D1").Resize(k, 3) = Application.Transpose(aResults)


End Sub