Excel - Change cell colour based on a date












0















I'm trying to use this Sub I found on the forum, but I'm having lots of problems because in my sheet, I've got some date cells with * or other without any information inside and when the Sub gets to these cells multiple errors occurs, could anyone help me with this issue?



Thank you very much in advance.



Sub WorkOutTime()

dim columnToUse as string
columnToUse = "X"

Dim expired As Integer
expired = 3 'red

Dim twoDays As Integer
twoDays = 8 'blue

Dim sevenDays As Integer
sevenDays = 27 ' yellow

Dim fourteenDays As Integer
fourteenDays = 7 ' purple


Dim currentCell As Integer
currentCell = 1

Do While (True)

If (Range(columnToUse & currentCell).Value = "") Then
Exit Do
End If


Dim timeNow As Date
timeNow = Date

Dim willContinue As Boolean
willContinue = True

Dim dateDifference As Integer

dateDifference = dateDiff("d", timeNow, Range(columnToUse & currentCell).Value)

If dateDifference >= 14 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = fourteenDays
willContinue = False
End If

If dateDifference <= 7 And dateDifference > 2 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = sevenDays
End If

If dateDifference <= 2 And dateDifference >= 0 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = twoDays
End If

If dateDifference < 0 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = expired
End If

currentCell = currentCell + 1

Loop

End Sub









share|improve this question




















  • 1





    Would Conditional Formatting not work? Also, what error(s) do you get, where?

    – BruceWayne
    Jan 25 at 16:21


















0















I'm trying to use this Sub I found on the forum, but I'm having lots of problems because in my sheet, I've got some date cells with * or other without any information inside and when the Sub gets to these cells multiple errors occurs, could anyone help me with this issue?



Thank you very much in advance.



Sub WorkOutTime()

dim columnToUse as string
columnToUse = "X"

Dim expired As Integer
expired = 3 'red

Dim twoDays As Integer
twoDays = 8 'blue

Dim sevenDays As Integer
sevenDays = 27 ' yellow

Dim fourteenDays As Integer
fourteenDays = 7 ' purple


Dim currentCell As Integer
currentCell = 1

Do While (True)

If (Range(columnToUse & currentCell).Value = "") Then
Exit Do
End If


Dim timeNow As Date
timeNow = Date

Dim willContinue As Boolean
willContinue = True

Dim dateDifference As Integer

dateDifference = dateDiff("d", timeNow, Range(columnToUse & currentCell).Value)

If dateDifference >= 14 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = fourteenDays
willContinue = False
End If

If dateDifference <= 7 And dateDifference > 2 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = sevenDays
End If

If dateDifference <= 2 And dateDifference >= 0 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = twoDays
End If

If dateDifference < 0 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = expired
End If

currentCell = currentCell + 1

Loop

End Sub









share|improve this question




















  • 1





    Would Conditional Formatting not work? Also, what error(s) do you get, where?

    – BruceWayne
    Jan 25 at 16:21
















0












0








0








I'm trying to use this Sub I found on the forum, but I'm having lots of problems because in my sheet, I've got some date cells with * or other without any information inside and when the Sub gets to these cells multiple errors occurs, could anyone help me with this issue?



Thank you very much in advance.



Sub WorkOutTime()

dim columnToUse as string
columnToUse = "X"

Dim expired As Integer
expired = 3 'red

Dim twoDays As Integer
twoDays = 8 'blue

Dim sevenDays As Integer
sevenDays = 27 ' yellow

Dim fourteenDays As Integer
fourteenDays = 7 ' purple


Dim currentCell As Integer
currentCell = 1

Do While (True)

If (Range(columnToUse & currentCell).Value = "") Then
Exit Do
End If


Dim timeNow As Date
timeNow = Date

Dim willContinue As Boolean
willContinue = True

Dim dateDifference As Integer

dateDifference = dateDiff("d", timeNow, Range(columnToUse & currentCell).Value)

If dateDifference >= 14 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = fourteenDays
willContinue = False
End If

If dateDifference <= 7 And dateDifference > 2 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = sevenDays
End If

If dateDifference <= 2 And dateDifference >= 0 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = twoDays
End If

If dateDifference < 0 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = expired
End If

currentCell = currentCell + 1

Loop

End Sub









share|improve this question
















I'm trying to use this Sub I found on the forum, but I'm having lots of problems because in my sheet, I've got some date cells with * or other without any information inside and when the Sub gets to these cells multiple errors occurs, could anyone help me with this issue?



Thank you very much in advance.



Sub WorkOutTime()

dim columnToUse as string
columnToUse = "X"

Dim expired As Integer
expired = 3 'red

Dim twoDays As Integer
twoDays = 8 'blue

Dim sevenDays As Integer
sevenDays = 27 ' yellow

Dim fourteenDays As Integer
fourteenDays = 7 ' purple


Dim currentCell As Integer
currentCell = 1

Do While (True)

If (Range(columnToUse & currentCell).Value = "") Then
Exit Do
End If


Dim timeNow As Date
timeNow = Date

Dim willContinue As Boolean
willContinue = True

Dim dateDifference As Integer

dateDifference = dateDiff("d", timeNow, Range(columnToUse & currentCell).Value)

If dateDifference >= 14 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = fourteenDays
willContinue = False
End If

If dateDifference <= 7 And dateDifference > 2 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = sevenDays
End If

If dateDifference <= 2 And dateDifference >= 0 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = twoDays
End If

If dateDifference < 0 And willContinue Then
Range(columnToUse & currentCell).Interior.ColorIndex = expired
End If

currentCell = currentCell + 1

Loop

End Sub






microsoft-excel worksheet-function






share|improve this question















share|improve this question













share|improve this question




share|improve this question








edited Jan 25 at 15:55









cybernetic.nomad

2,386517




2,386517










asked Jan 25 at 13:12









MarneMarne

1




1








  • 1





    Would Conditional Formatting not work? Also, what error(s) do you get, where?

    – BruceWayne
    Jan 25 at 16:21
















  • 1





    Would Conditional Formatting not work? Also, what error(s) do you get, where?

    – BruceWayne
    Jan 25 at 16:21










1




1





Would Conditional Formatting not work? Also, what error(s) do you get, where?

– BruceWayne
Jan 25 at 16:21







Would Conditional Formatting not work? Also, what error(s) do you get, where?

– BruceWayne
Jan 25 at 16:21












0






active

oldest

votes











Your Answer








StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "3"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);

StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});

function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});


}
});














draft saved

draft discarded


















StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fsuperuser.com%2fquestions%2f1398357%2fexcel-change-cell-colour-based-on-a-date%23new-answer', 'question_page');
}
);

Post as a guest















Required, but never shown

























0






active

oldest

votes








0






active

oldest

votes









active

oldest

votes






active

oldest

votes
















draft saved

draft discarded




















































Thanks for contributing an answer to Super User!


  • Please be sure to answer the question. Provide details and share your research!

But avoid



  • Asking for help, clarification, or responding to other answers.

  • Making statements based on opinion; back them up with references or personal experience.


To learn more, see our tips on writing great answers.




draft saved


draft discarded














StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fsuperuser.com%2fquestions%2f1398357%2fexcel-change-cell-colour-based-on-a-date%23new-answer', 'question_page');
}
);

Post as a guest















Required, but never shown





















































Required, but never shown














Required, but never shown












Required, but never shown







Required, but never shown

































Required, but never shown














Required, but never shown












Required, but never shown







Required, but never shown







Popular posts from this blog

Сан-Квентин

8-я гвардейская общевойсковая армия

Алькесар