Apr 17 2022 02:57 PM
I'm running Windows 10, Excel 2013
In the attached example, I'd like to be able to run a macro that runs down Column F from the top to bottom (which is over 300 rows) and insert a row and a formula such as is called out in the example to determine the delta between the dates throughout the column. If that number is less than 4, then the resulting cells should display red.
There will be blanks every 6 or so rows, such as showing in rows 24 and 32 in the example; which in these cases, no action need be taken. Is this possible? Any help is greatly appreciated.
Apr 17 2022 04:59 PM
Sub dates()
Dim i As Integer
Dim lngzeilemax As Integer
lngzeilemax = Cells(Rows.Count, 6).End(xlUp).Row
For i = 2 To lngzeilemax
If Cells(i, 6) = "" Then
If Application.WorksheetFunction.Days(Cells(i + 1, 6), Cells(i - 1, 6)) < 4 And Application.WorksheetFunction.Days(Cells(i + 1, 6), Cells(i - 1, 6)) >= 0 Then
Cells(i, 6).Value = Application.WorksheetFunction.Days(Cells(i + 1, 6), Cells(i - 1, 6))
Cells(i, 6).NumberFormat = "0"
Cells(i, 6).Interior.ColorIndex = 3
Else
If Application.WorksheetFunction.Days(Cells(i - 1, 6), Cells(i + 1, 6)) < 4 And Application.WorksheetFunction.Days(Cells(i - 1, 6), Cells(i + 1, 6)) >= 0 Then
Cells(i, 6).Value = Application.WorksheetFunction.Days(Cells(i - 1, 6), Cells(i + 1, 6))
Cells(i, 6).NumberFormat = "0"
Cells(i, 6).Interior.ColorIndex = 3
Else
End If
End If
Else
End If
Next i
End Sub
Maybe with this code. Click the button in cell I2 in the attached file to start the macro.
Apr 17 2022 06:32 PM
Apr 17 2022 06:34 PM
Apr 17 2022 07:36 PM
Apr 18 2022 07:21 AM
Sub dates()
Dim i As Integer
Dim lngzeilemax As Integer
Dim j As Integer
Dim z As Integer
Dim w As Integer
lngzeilemax = Cells(Rows.Count, 6).End(xlUp).Row
j = Application.WorksheetFunction.Count(Range(Cells(1, 6), Cells(lngzeilemax, 6)))
z = Application.WorksheetFunction.CountBlank(Range(Cells(1, 6), Cells(lngzeilemax, 6)))
w = j - z + z + j
For i = 2 To w
If Cells(i, 6) <> "" And Cells(i + 1, 6) <> "" Then
Cells(i + 1, 6).EntireRow.Insert
Else
If Cells(i, 6) = "" Then
If Application.WorksheetFunction.Days(Cells(i + 1, 6), Cells(i - 1, 6)) < 4 And Application.WorksheetFunction.Days(Cells(i + 1, 6), Cells(i - 1, 6)) >= 0 Then
Cells(i, 6).FormulaR1C1 = "=DAYS(R[1]C[0],R[-1]C[0])"
Cells(i, 6).NumberFormat = "0"
Cells(i, 6).Interior.ColorIndex = 3
Else
If Application.WorksheetFunction.Days(Cells(i - 1, 6), Cells(i + 1, 6)) < 4 And Application.WorksheetFunction.Days(Cells(i - 1, 6), Cells(i + 1, 6)) >= 0 Then
Cells(i, 6).FormulaR1C1 = "=DAYS(R[-1]C[0],R[1]C[0])"
Cells(i, 6).NumberFormat = "0"
Cells(i, 6).Interior.ColorIndex = 3
Else
End If
End If
Else
End If
End If
Next i
End Sub
You can try this code. Click the button in cell I1 in the attached file to start the macro. The macro now inserts blank rows and displays the formula where applicable.
Apr 20 2022 12:12 AM
This works great on the sample sheet. I now have the following 2 questions:
1) What change to the code is needed to target column M instead of F?
2) Can this run on larger datasets? I get a Run-time error: Overflow message when trying to run on a sheet with 72000 rows.
Apr 20 2022 02:50 AM
1) You would have to change the number of the column in expressions such as:
Cells(i + 1, 6).EntireRow.Insert
Cells(i, 6).NumberFormat = "0"
Application.WorksheetFunction.Days(Cells(i - 1, 6), Cells(i + 1, 6)) < 4
6 is the number of column F.
You would have to enter 13 to target column M.
2) For the variables in the code i have changed the data type from INTEGER to DOUBLE in the attached file. This allows for larger datasets.