Check delay with past occurance.

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,422
Office Version
  1. 2010
Hello,

I require to check delay 3 of each character (1 with 1, X with X & 2 with 2) with the past occurrence of the same character.

For example column C, start-checking delay of "X" is in cell C7 steps back in cell C6 result is "X" (so far delay of "X" in C7 = 1 Print delay result in F7 = 1)

Check delay of "X" is in cell C8 steps back in cell C7 result is "X" (so far delay of "X" in C8 = 1 Print delay result in F8 = 1)

Check delay of "2" is in cell C9 steps back in cells "2" not found (so far delay of "2" in C9 = 0 Print delay result in F9 = 0)

Check delay of "X" is in cell C11 steps back in cells "X" found 3 steps back (so far delay of "X" in C11 = 3 Print delay result in F11 = 3)

Resume check each character with past occurrence finds in the column back rows

Sheet1 example....


Book1
ABCDEFGH
1
2
3
4NYearn1n2EM1Delayn1Delayn2
5NYearn1n2EM1Delayn1Delayn2
612001X1
722001XX10
832001X112
9420012101
10520011X03
1162001X230
1272001X113
13820011X33
14920011112
151020011X12
16112001X142
171220011121
1813200111
19142001X1
2015200111
2116200111
2217200121
2318200111
24192001X1
2520200111
26212001X1
2722200112
2823200111
2924200111
3025200111
3126200111
322720011X
3328200122
342920011X
3530200121
363120011X
37322001X1
38332001X2
39342001X1
4035200111
41362001XX
423720012X
43382001XX
44392001XX
4540200111
4641200111
474220012X
4843200112
49442001X1
50452001X1
51462001X1
52472001X1
53482001X1
5449200121
55502001XX
56
57
Sheet1


Thank you all
Excel 2000
Regards,
Moti
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
This?


Book1
ABCDEFG
4NYearn1n2EM1Delayn1Delayn2
5NYearn1n2EM1Delayn1Delayn2
612001X1
722001XX10
832001X112
9420012101
10520011X03
1162001X230
1272001X113
13820011X33
14920011112
151020011X12
16112001X142
171220011121
181320011111
19142001X131
201520011121
211620011111
2217200121131
231820011121
24192001X151
252020011121
26212001X121
2722200112216
282320011112
292420011111
302520011111
312620011111
322720011X117
3328200122116
342920011X22
353020012124
363120011X22
37322001X1112
38332001X215
39342001X112
403520011141
41362001XX25
423720012X71
43382001XX21
44392001XX11
454020011155
464120011111
474220012X53
4843200112210
49442001X153
50452001X111
51462001X111
52472001X111
53482001X111
544920012171
55502001XX28
Sheet1
Cell Formulas
RangeFormula
F7{=MOD(ROW()-MAX(IF(C$6:C6=C7,ROW(C$6:C6))),ROW())}
Press CTRL+SHIFT+ENTER to enter array formulas.


Copy formula across and down.

WBD
 
Upvote 0
This?

[TABLE="width: 85%"]
<tbody>[TR]
[TD]
Array Formulas[TABLE="width: 100%"]
<tbody>[TR]
[TH="width: 10"]Cell
[/TH]
[TH="align: left"]Formula
[/TH]
[/TR]
[TR]
[TH="width: 10"]F7
[/TH]
[TD="align: left"]{=MOD(ROW()-MAX(IF(C$6:C6=C7,ROW(C$6:C6))),ROW())}
[/TD]
[/TR]
</tbody>[/TABLE]
Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}.
Note: Do not try and enter the {} manually yourself[/TD]
[/TR]
</tbody>[/TABLE]



Copy formula across and down.

WBD


Thank you WBD, formula is working correct. Please could you tell me how can I run it through VBA so it can leave the values only

Regards,
Moti
 
Last edited:
Upvote 0
Hello, I tried my best to creating a small code and run the formula via macro but the macro below wipeout the borders. Please can anybody will help with creating a VBA solution

Code:
 Sub Fill_ArrayFormula()
    Dim lngLastRow As Long
    lngLastRow = Cells(Rows.Count, "C").End(xlUp).Row
    Range("F7").FormulaArray = "=MOD(ROW()-MAX(IF(C$6:C6=C7,ROW(C$6:C6))),ROW())"
    Range("F7:G7").FillRight
    Range("F7:G" & lngLastRow).FillDown
    Range("F7:G" & lngLastRow) = Range("F7:G" & lngLastRow).Value
End Sub


Regards,
Moti
 
Last edited:
Upvote 0
Try this instead:

Code:
Sub Fill_ArrayFormula()
    Dim lngLastRow As Long
    lngLastRow = Cells(Rows.Count, "C").End(xlUp).Row
    Range("F7").FormulaArray = "=MOD(ROW()-MAX(IF(C$6:C6=C7,ROW(C$6:C6))),ROW())"
    Range("F7").Copy
    Range("G7").PasteSpecial xlPasteFormulas
    Range("F7:G7").Copy
    Range("F8:G" & lngLastRow).PasteSpecial xlPasteFormulas
    Range("F7:G" & lngLastRow).Value = Range("F7:G" & lngLastRow).Value
    Application.CutCopyMode = False
    Range("A4").Select
End Sub

WBD
 
Upvote 0
Try this instead:

Code:
Sub Fill_ArrayFormula()
    Dim lngLastRow As Long
    lngLastRow = Cells(Rows.Count, "C").End(xlUp).Row
    Range("F7").FormulaArray = "=MOD(ROW()-MAX(IF(C$6:C6=C7,ROW(C$6:C6))),ROW())"
    Range("F7").Copy
    Range("G7").PasteSpecial xlPasteFormulas
    Range("F7:G7").Copy
    Range("F8:G" & lngLastRow).PasteSpecial xlPasteFormulas
    Range("F7:G" & lngLastRow).Value = Range("F7:G" & lngLastRow).Value
    Application.CutCopyMode = False
    Range("A4").Select
End Sub

WBD
Thank you WBD, yes it is solved the borders issue. I changed the range as per my original data 25 columns across and 7000+ rows down it take a long time to get populate the results. Also I tried to fraction the sub in 5 steps but can't solve it.

Please is there any other way?

Regards,
Moti
 
Upvote 0
OK. Re-written entirely in VBA without array formula. I ran it across 25 columns with 7000 rows in each column and it completed in less than 5 seconds:

Code:
Public Sub CheckDelay()

Const FIRST_NUM_COLUMN = 3 ' First column of numbers - in our case "C"
Const NUM_COLUMNS = 25 ' Number of columns we're calculating for
Const FIRST_ROW = 6 ' The first row of data (delay will be left blank on this row)
Const BLANK_COLUMNS = 1 ' Number of blank columns between the numbers and the delays

Dim last1 As Long
Dim last2 As Long
Dim lastX As Long
Dim thisRow As Long
Dim thisCol As Long
Dim lastRow As Long
Dim delay As Long

' No screen updating please
Application.ScreenUpdating = False

' Work across all columns
For thisCol = 0 To NUM_COLUMNS - 1
    ' Find the last row
    lastRow = Cells(Rows.Count, FIRST_NUM_COLUMN + thisCol).End(xlUp).Row
    
    ' Reset the row trackers
    last1 = 0
    last2 = 0
    lastX = 0
    
    ' Process all rows
    For thisRow = FIRST_ROW To lastRow
        ' Determine what's in the cell and remember the last row we found the value
        Select Case Cells(thisRow, FIRST_NUM_COLUMN + thisCol).Value
            Case 1
                delay = IIf(last1 = 0, 0, thisRow - last1)
                last1 = thisRow
            Case 2
                delay = IIf(last2 = 0, 0, thisRow - last2)
                last2 = thisRow
            Case "X"
                delay = IIf(lastX = 0, 0, thisRow - lastX)
                lastX = thisRow
        End Select
        
        ' For cells after the first row, record the delay
        If thisRow > FIRST_ROW Then Cells(thisRow, FIRST_NUM_COLUMN + NUM_COLUMNS + BLANK_COLUMNS + thisCol).Value = delay
    Next thisRow
Next thisCol

' Turn on screen updating
Application.ScreenUpdating = True

End Sub

You can set up the number of columns etc. at the top of the function.

WBD
 
Upvote 0
OK. Re-written entirely in VBA without array formula. I ran it across 25 columns with 7000 rows in each column and it completed in less than 5 seconds:

Code:
Public Sub CheckDelay()

Const FIRST_NUM_COLUMN = 3 ' First column of numbers - in our case "C"
Const NUM_COLUMNS = 25 ' Number of columns we're calculating for
Const FIRST_ROW = 6 ' The first row of data (delay will be left blank on this row)
Const BLANK_COLUMNS = 1 ' Number of blank columns between the numbers and the delays

Dim last1 As Long
Dim last2 As Long
Dim lastX As Long
Dim thisRow As Long
Dim thisCol As Long
Dim lastRow As Long
Dim delay As Long

' No screen updating please
Application.ScreenUpdating = False

' Work across all columns
For thisCol = 0 To NUM_COLUMNS - 1
    ' Find the last row
    lastRow = Cells(Rows.Count, FIRST_NUM_COLUMN + thisCol).End(xlUp).Row
    
    ' Reset the row trackers
    last1 = 0
    last2 = 0
    lastX = 0
    
    ' Process all rows
    For thisRow = FIRST_ROW To lastRow
        ' Determine what's in the cell and remember the last row we found the value
        Select Case Cells(thisRow, FIRST_NUM_COLUMN + thisCol).Value
            Case 1
                delay = IIf(last1 = 0, 0, thisRow - last1)
                last1 = thisRow
            Case 2
                delay = IIf(last2 = 0, 0, thisRow - last2)
                last2 = thisRow
            Case "X"
                delay = IIf(lastX = 0, 0, thisRow - lastX)
                lastX = thisRow
        End Select
        
        ' For cells after the first row, record the delay
        If thisRow > FIRST_ROW Then Cells(thisRow, FIRST_NUM_COLUMN + NUM_COLUMNS + BLANK_COLUMNS + thisCol).Value = delay
    Next thisRow
Next thisCol

' Turn on screen updating
Application.ScreenUpdating = True

End Sub

You can set up the number of columns etc. at the top of the function.

WBD
Amazing! WBD, eye-blinking solution what a big difference using formula and this VBA it is just fantastic!

Thank you so much for your kind help

Have a good day

Regards,
Moti
 
Upvote 0

Forum statistics

Threads
1,224,816
Messages
6,181,143
Members
453,021
Latest member
Justyna P

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