find the value in range and if exist enter date in the same row in next available column cell

Prashant1211

New Member
Joined
Jun 9, 2020
Messages
33
Office Version
  1. 2016
Platform
  1. Windows
Dear all, I am trying to create a OTD list for projects dispatched. I have a excel application which is used to dispatch the project. So what i am trying is the OTD list (another workbook) should be updated with project name and dispatch date once the project is dispatched from the application. below is my code.
Problem i am facing is if the same project is dispatched again then code create one more entry in OTD list in next row rather then searching if the project already exist. and if the project already exist than it should add the next date in-front of the project in next available column (This is required because project is dispatched in n number of lots). and if not then should work as per below code.

Can someone please help me in this. Thanks for your support.

Sub OTD()
Dim x As Workbook
Dim LR As Integer
Dim answer As Integer

answer = MsgBox("Update OTD List?", vbQuestion + vbYesNo)

If answer = vbYes Then

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Sheets("Main Sheet").Range("B5").Copy 'project no. from main application copied
Set x = Workbooks.Open("File location OTD list") ' otd list open


LR = x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Row

x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Select

Selection.Value = Date

Selection.NumberFormat = "dd/mm/yyyy"

'Close x:
x.Save
x.Close

Else
End If

End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
See if this works for you.

VBA Code:
Sub OTD()
Dim x As Workbook
Dim LR As Integer
Dim answer As Integer
answer = MsgBox("Update OTD List?", vbQuestion + vbYesNo)
    If answer = vbYes Then
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        Set x = Workbooks.Open("File location OTD list") ' otd list open
            If Application.CountIf(x.Sheets("OTD").Range("A:A")) = 0 Then
                Sheets("Main Sheet").Range("B5").Copy 'project no. from main application copied
                LR = x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Row
                x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Date
               x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).NumberFormat = "dd/mm/yyyy"
               'Close x:
               x.Close True
           Else
              MsgBox "Project Number Already Exists in OTD list.", vbInformation, "ENTRY FOUND"
           End If
     End If
End Sub
 
Upvote 0
Try:
VBA Code:
Sub OTD()
    Dim x As Workbook, fnd As Range, srcWS As Worksheet, lCol As Long
    Set srcWS = ThisWorkbook.Sheets("Main Sheet")
    If MsgBox("Update OTD List?", vbQuestion + vbYesNo) = vbYes Then
        Application.ScreenUpdating = False
        Set x = Workbooks.Open("File location OTD list") ' otd list open
        Set fnd = Sheets("OTD").Range("A:A").Find(srcWS.Range("B5").Value, LookIn:=xlValues, lookat:=xlWhole)
        If fnd Is Nothing Then
            srcWS.Range("B5").Copy
            With Sheets("OTD")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = Format(Date, "dd/mm/yyyy")
            End With
        Else
            With Sheets("OTD")
                lCol = .Cells(fnd.Row, Columns.Count).End(xlToLeft).Column + 1
                .Cells(fnd.Row, lCol) = Format(Date, "dd/mm/yyyy")
            End With
        End If
        x.Close True
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End If
End Sub
 
Upvote 0
Hi
JLGWhiz

, Thanks for your reply but i want to search for the project no. in the list before copying it, if it exist then just put date in front of it (in the next available column) dont copy and if not found than copy it.
 
Upvote 0
Try the macro I suggested in Post #3.
 
Upvote 0
Thank you very much mumps, with small modifications your code worked well.

.Cells(.Rows.Count, "B").End(xlUp).Offset(1).Select
Selection.Value = Date

Selection.NumberFormat = "dd/mm/yyyy"

End With
Else
With Sheets("OTD")
lCol = .Cells(fnd.Row, Columns.Count).End(xlToLeft).Column + 1
.Cells(fnd.Row, lCol).Select
Selection.Value = Date

Selection.NumberFormat = "dd/mm/yyyy"
 
Upvote 0
You are very welcome. :) My original code should have worked without your modifications. You don't have to select the cell to add the formatted date. Did my version not work for you?
 
Upvote 0
No it gave some error and when i modified as shown above it worked perfectly. Thanks a lot and I wish you a nice weekend.
 
Upvote 0
Just for continuity sake, here is a revised version.
VBA Code:
Sub OTD()
Dim x As Workbook
Dim LR As Integer
Dim answer As Integer
answer = MsgBox("Update OTD List?", vbQuestion + vbYesNo)
    If answer = vbYes Then
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        Set x = Workbooks.Open(ThisWorkbook.Path & "\File location OTD list") ' otd list open
            If Application.CountIf(x.Sheets("OTD").Range("A:A"), ThisWorkbook.Sheets("Main Sheet").Range("B5")) = 0 Then
               ThisWorkbook.Sheets("Main Sheet").Range("B5").Copy 'project no. from main application copied
                LR = x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Row
                x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Date
               x.Sheets("OTD").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).NumberFormat = "dd/mm/yyyy"
               'Close x:
               x.Close True
           Else
              MsgBox "Project Number Already Exists in OTD list.", vbInformation, "ENTRY FOUND"
           End If
     End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

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