Originally Posted by
SteynfaardtD
Hi Sintek,
Went and played with it, But is there a way to fix the Date format as it now only seems to work on,
"mm/dd/yyyy" and I cant seem to change the Format of the cells to match "dd-mmm-yyyy"
Hi Sintek,
I managed thank you.
I changed this
Sub J3v16()
Dim Fnd As Range, Rng As Range, Dt As Date, Status As String, row As Long, col As Long, cnt As Long, lc As Long
With Sheets("CC1").ListObjects(1)
lc = .Range.Columns.Count
.Parent.Cells(1, lc + 2).Resize(, 2) = Array("Status", "Days")
For row = 2 To .Range.Rows.Count
Set Rng = .Range(row, lc - 2).Resize(, 3)
If .Range(row, lc) = "Online" Then
.Parent.Cells(row, lc + 2) = "Online"
ElseIf Application.WorksheetFunction.CountIf(Rng, "Offline") > 1 Then
.Parent.Cells(row, lc + 2) = "Offline"
ElseIf Application.WorksheetFunction.CountIf(Rng, "-") = 1 Then
.Parent.Cells(row, lc + 2) = "-"
Else
.Parent.Cells(row, lc + 2) = "Online"
End If
Status = .Parent.Cells(row, lc + 2)
Set Fnd = .Range(row, 2).Resize(, .Range.Columns.Count - 1).Find(Status, after:=.Range(row, 2), searchdirection:=xlPrevious)
For col = Fnd.Column To (.Range.Cells(1, 1).Column + 1) Step -1
If .Range(row, col).Value = Status Then
cnt = cnt + 1
Else
Dt = .Range(1, lc - cnt + 1).Value
.Parent.Cells(row, lc + 3) = Application.WorksheetFunction.NetworkDays(Dt, Date)
cnt = 0
Exit For
End If
Next col
Next row
End With
End Sub
To This
Sub J3v16()
Dim Fnd As Range, Rng As Range, Dt As Date, Status As String, row As Long, col As Long, cnt As Long, lc As Long
With Sheets("CC1").ListObjects(1)
lc = .Range.Columns.Count
.Parent.Cells(1, lc + 2).Resize(, 2) = Array("Status", "Days")
For row = 2 To .Range.Rows.Count
Set Rng = .Range(row, lc - 2).Resize(, 3)
If .Range(row, lc) = "Online" Then
.Parent.Cells(row, lc + 2) = "Online"
ElseIf Application.WorksheetFunction.CountIf(Rng, "Offline") > 1 Then
.Parent.Cells(row, lc + 2) = "Offline"
ElseIf Application.WorksheetFunction.CountIf(Rng, "-") = 1 Then
.Parent.Cells(row, lc + 2) = "-"
Else
.Parent.Cells(row, lc + 2) = "Online"
End If
Status = .Parent.Cells(row, lc + 2)
Set Fnd = .Range(row, 2).Resize(, .Range.Columns.Count - 1).Find(Status, after:=.Range(row, 2), searchdirection:=xlPrevious)
For col = Fnd.Column To (.Range.Cells(1, 1).Column + 1) Step -1
If .Range(row, col).Value = Status Then
cnt = cnt + 1
Else
Dt = Format(.Range(1, lc - cnt + 1).Value, "dd/mmm/yy")
.Parent.Cells(row, lc + 3) = Application.WorksheetFunction.NetworkDays(Dt, Date)
cnt = 0
Exit For
End If
Next col
Next row
End With
End Sub
Bookmarks