Add 5 days to the date in column A

donlincolnmre2

Board Regular
Joined
Dec 23, 2006
Messages
142
Hello

I have a spread sheet that have some telephone numbers in column J (the last column in this case 3rd column)

Those Numbers should be compared against telephone numbers in column F (the 2nd column in the below data) and if found then the macro should go to column A and there is a DATE in that Row, so the macro should add 5 days to that date.

Any help would be greatly appreciated.

Thanks.


Here is the dummy data.



03/06/11 6506782843 8004431032
03/12/11 8004431032 9168714789
03/12/11 9163177994 9166458954
03/17/11 9166458954 3237341539
03/05/11 9164298311 7145394449
03/06/11 3237341539 9169235278
03/07/11 9165430667 5308853088
03/07/11 9162516184 3237346671
02/17/11 5308853088 5303123793
02/17/11 9168714600 7148667539
03/02/11 9168714789 9164810983
03/05/11 7148667539 9166126327
03/06/11 9169728290 9163801916
03/06/11 9166126327 9517296578
03/07/11 9163594269 3102911500
03/07/11 9169143068
03/07/11 3102911500
03/07/11 916.612.3613
03/07/11 916-359-1002
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Something like...
Rich (BB code):
Sub add5daysOnMatch()
    Dim r As Long, x As Long
    Dim chekVal As String
    Dim tempVal As String
    Dim TeleTable As Range
    Dim DateTable As Range
    Dim found As Range
    Cells.Font.Bold = False
    Set TeleTable = Range("J1:J" & Cells(Rows.Count, 10).End(xlUp).Row)
    Set DateTable = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row _
                    & ",F1:F" & Cells(Rows.Count, 1).End(xlUp).Row)
    For r = 1 To DateTable.Rows.Count
        chekVal = DateTable.Cells(r, 6)
        If Not IsNumeric(chekVal) Then
            For x = 1 To Len(chekVal)
                If IsNumeric(Mid(chekVal, x, 1)) Then
                    tempVal = tempVal & Mid(chekVal, x, 1)
                End If
            Next x
            chekVal = tempVal
        End If
        Set found = TeleTable.Find(chekVal, , xlValues, xlWhole)
        If Not found Is Nothing Then
            DateTable.Cells(r, 1) = DateTable.Cells(r, 1) + 5
            DateTable.Cells(r, 1).Font.Bold = True
        End If
    Next r
End Sub
 
Upvote 0
Oops...
Need to add the line in red otherwise only the first formatted phone will be found.
Rich (BB code):
Option Explicit
Sub add5daysOnMatch()
    Dim r As Long, x As Long
    Dim chekVal As String
    Dim tempVal As String
    Dim TeleTable As Range
    Dim DateTable As Range
    Dim found As Range
    Cells.Font.Bold = False
    Set TeleTable = Range("J1:J" & Cells(Rows.Count, 10).End(xlUp).Row)
    Set DateTable = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row _
                    & ",F1:F" & Cells(Rows.Count, 1).End(xlUp).Row)
    For r = 1 To DateTable.Rows.Count
        chekVal = DateTable.Cells(r, 6)
        If Not IsNumeric(chekVal) Then
            tempVal = ""
            For x = 1 To Len(chekVal)
                If IsNumeric(Mid(chekVal, x, 1)) Then
                    tempVal = tempVal & Mid(chekVal, x, 1)
                End If
            Next x
            chekVal = tempVal 
        End If
        Set found = TeleTable.Find(chekVal, , xlValues, xlWhole)
        If Not found Is Nothing Then
            DateTable.Cells(r, 1) = DateTable.Cells(r, 1) + 5
            DateTable.Cells(r, 1).Font.Bold = True
        End If
    Next r
End Sub
 
Upvote 0
After I ran the macro it seems that I have found a logical error on my part.

since the column A has some old dates, e.g. from Jan, Feb, and when 5 days are added to them, they just move 5 days ahead, like e.g. if its contains 01-05 then 5 days added will be 01-10, what the macro should do is to read the current date from the computer and add 5 days to that date and make that change in that row, and I will accomplish what I’m looking to do.

Thanks.
 
Upvote 0
Rich (BB code):
Sub add5daysOnMatch()
    Dim r As Long, x As Long
    Dim chekVal As String
    Dim tempVal As String
    Dim TeleTable As Range
    Dim DateTable As Range
    Dim found As Range
    Cells.Font.Bold = False
    Set TeleTable = Range("J1:J" & Cells(Rows.Count, 10).End(xlUp).Row)
    Set DateTable = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row _
                    & ",F1:F" & Cells(Rows.Count, 1).End(xlUp).Row)
    For r = 1 To DateTable.Rows.Count
        chekVal = DateTable.Cells(r, 6)
        If Not IsNumeric(chekVal) Then
            tempVal = ""
            For x = 1 To Len(chekVal)
                If IsNumeric(Mid(chekVal, x, 1)) Then
                    tempVal = tempVal & Mid(chekVal, x, 1)
                End If
            Next x
            chekVal = tempVal
        End If
        Set found = TeleTable.Find(chekVal, , xlValues, xlWhole)
        If Not found Is Nothing Then
            If Date > DateTable.Cells(r, 1) Then
                DateTable.Cells(r, 1) = Date + 5
            Else
                DateTable.Cells(r, 1) = DateTable.Cells(r, 1) + 5
            End If
            DateTable.Cells(r, 1).Font.Bold = True
        End If
    Next r
End Sub
 
Upvote 0
Hello

The macro is still adding 5 days to the date which is found in column A

Can you make a change, that the macro should read computers current date (from the computer clock) and add 5 days to it and then put that value in that row of column A

Hope that make sense

Thanks.
 
Upvote 0
Rich (BB code):
Sub add5daysOnMatch()
    Dim r As Long, x As Long
    Dim chekVal As String
    Dim tempVal As String
    Dim TeleTable As Range
    Dim DateTable As Range
    Dim found As Range
    Cells.Font.Bold = False
    Set TeleTable = Range("J1:J" & Cells(Rows.Count, 10).End(xlUp).Row)
    Set DateTable = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row _
                    & ",F1:F" & Cells(Rows.Count, 1).End(xlUp).Row)
    For r = 1 To DateTable.Rows.Count
        chekVal = DateTable.Cells(r, 6)
        If Not IsNumeric(chekVal) Then
            tempVal = ""
            For x = 1 To Len(chekVal)
                If IsNumeric(Mid(chekVal, x, 1)) Then
                    tempVal = tempVal & Mid(chekVal, x, 1)
                End If
            Next x
            chekVal = tempVal
        End If
        Set found = TeleTable.Find(chekVal, , xlValues, xlWhole)
        If Not found Is Nothing Then
            DateTable.Cells(r, 1) = Date + 5
            DateTable.Cells(r, 1).Font.Bold = True
        End If
    Next r
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,787
Messages
6,121,565
Members
449,038
Latest member
Guest1337

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