Macro to find match and Update neighbouring cell(s)

NeoSez

Board Regular
Joined
Aug 14, 2020
Messages
210
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
I have a master sheet that has hundreds of rows and several columns, that I want to update with a status list that changes daily. Sometimes, it may only have 20 updates. I want it to find by the Tracking Column "G" and if there is a match in "A", to update the status column "C" with the data from "H" and leave everything else in the column untouched.
Here's the last part of this: I need to extract only the date from Column "I" to add to "D" as part of the update. How do I extract only the date portion?
I found this code but I don't quite understand it, as I am new to. It worked well, but it returns a '#name? error'. Is it because there is not a match? How to change the formula to not return an error and leave the unmatched column(s) untouched?
Thank you for your assistance.

VBA Code:
Sub MultiFindNReplace()
'Updateby Extendoffice
Dim Rng As Range
Dim InputRng As Range, ReplaceRng As Range
xTitleId = "Update"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
Set ReplaceRng = Application.InputBox("Replace Range :", xTitleId, Type:=8)
Application.ScreenUpdating = False
For Each Rng In ReplaceRng.Columns(1).Cells
    InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next
Application.ScreenUpdating = True
End Sub

=IFERROR(INDEX($g$2:$h$16, MATCH(A2,$h$2:$h$500,0)),[B]cell[/B])  'returns #name? error'
 

Attachments

  • Update.JPG
    Update.JPG
    71.6 KB · Views: 60

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
This is nothing like your code but give it a try on a copy of your workbook:
Hopefully it does what you want
VBA Code:
Sub test()
Dim fullstr As String

lastmast = Cells(Rows.Count, "A").End(xlUp).Row
mastarr = Range(Cells(1, 1), Cells(lastmast, 4))
lastup = Cells(Rows.Count, "G").End(xlUp).Row
updt = Range(Cells(1, 7), Cells(lastmast, 9))

For i = 2 To lastmast
 For j = 2 To lastup
  If mastarr(i, 1) = updt(j, 1) Then
   mastarr(i, 3) = updt(j, 2)
   fullstr = updt(j, 3)
   For kk = 1 To Len(fullstr)
    If IsNumeric(Mid(fullstr, kk, 1)) Then
      dt = Mid(fullstr, kk, 9)
      mastarr(i, 4) = dt
      Exit For
    End If
   Next kk
  End If
 Next j
Next i
Range(Cells(1, 1), Cells(lastmast, 4)) = mastarr

End Sub
 
Upvote 0
This is nothing like your code but give it a try on a copy of your workbook:
Hopefully it does what you want
VBA Code:
Sub test()
Dim fullstr As String

lastmast = Cells(Rows.Count, "A").End(xlUp).Row
mastarr = Range(Cells(1, 1), Cells(lastmast, 4))
lastup = Cells(Rows.Count, "G").End(xlUp).Row
updt = Range(Cells(1, 7), Cells(lastmast, 9))

For i = 2 To lastmast
For j = 2 To lastup
  If mastarr(i, 1) = updt(j, 1) Then
   mastarr(i, 3) = updt(j, 2)
   fullstr = updt(j, 3)
   For kk = 1 To Len(fullstr)
    If IsNumeric(Mid(fullstr, kk, 1)) Then
      dt = Mid(fullstr, kk, 9)
      mastarr(i, 4) = dt
      Exit For
    End If
   Next kk
  End If
Next j
Next i
Range(Cells(1, 1), Cells(lastmast, 4)) = mastarr

End Sub

offthelip: THANK YOU SO MUCH!!! That worked. You're brilliant.
 
Upvote 0
This is nothing like your code but give it a try on a copy of your workbook:
Hopefully it does what you want
VBA Code:
Sub test()
Dim fullstr As String

lastmast = Cells(Rows.Count, "A").End(xlUp).Row
mastarr = Range(Cells(1, 1), Cells(lastmast, 4))
lastup = Cells(Rows.Count, "G").End(xlUp).Row
updt = Range(Cells(1, 7), Cells(lastmast, 9))

For i = 2 To lastmast
For j = 2 To lastup
  If mastarr(i, 1) = updt(j, 1) Then
   mastarr(i, 3) = updt(j, 2)
   fullstr = updt(j, 3)
   For kk = 1 To Len(fullstr)
    If IsNumeric(Mid(fullstr, kk, 1)) Then
      dt = Mid(fullstr, kk, 9)
      mastarr(i, 4) = dt
      Exit For
    End If
   Next kk
  End If
Next j
Next i
Range(Cells(1, 1), Cells(lastmast, 4)) = mastarr

End Sub

While your script works brilliantly, I tried to add to it and I failed.
I was working out another scenario and it threw me all kinds of errors.

New Scenario:
Columns G,H,I are now on Sheet 2 as F, X, T, instead of on the same sheet (sheet1).
=IF(C2="delivered", then extract the first date from Sheet 2, Column T ). So instead of having the date in the middle, the date will be at the front.
If not "DELIVERED", then enter nothing in column "D"

How would that code look like now? Thank you for your guidance.
 
Upvote 0
Your requirements aren't quite clear:
1: you ask for a check on C2="delivered" you haven't specified which worksheet to check C2 on , I have presumed sheet 2
2: you ask for a check on C2, which seems unlikely I have checked the value in column C for the row that matches the Id from sheets 1
3: you have asked if C2="delivered" that nothing is copied into column D, but you haven't specified whether I should or shouldn't copy stuff into column C , I presumed not.
4:To extract the data from the front of the string in column T I have changed the code to look for the first space in the string
try this:
VBA Code:
Sub test2()
Dim fullstr As String
With Worksheets("Sheet2")
lastup = .Cells(Rows.Count, "F").End(xlUp).Row ' find last row in column F of sheet 2
updt = Range(.Cells(1, 1), .Cells(lastup, 20)) ' pick columns A to T and all rows in sheet 2
' new mapping G is now F column 6
' H  is now X column 24
'I is now T column 20 Date is assumed to be all the characters up to the first space
End With
Worksheets("Sheet1").Select      ' lots of people say don't use select  but doing it once is quick and easy!!
lastmast = Cells(Rows.Count, "A").End(xlUp).Row
mastarr = Range(Cells(1, 1), Cells(lastmast, 4))

For i = 2 To lastmast
For j = 2 To lastup
  If mastarr(i, 1) = updt(j, 6) Then ' columnn F
  If updt(j, 3) = "delivered" Then
   mastarr(i, 3) = updt(j, 24) ' colunm X
   fullstr = updt(j, 20) ' Column I
   For kk = 1 To Len(fullstr)
    dt = Mid(fullstr, kk, 1)
    If dt = " " Then
      mastarr(i, 4) = Left(fullstr, kk - 1)
      Exit For
    End If
   Next kk
  End If
  End If
Next j
Next i
Range(Cells(1, 1), Cells(lastmast, 4)) = mastarr
 
Upvote 0
Your requirements aren't quite clear:
1: you ask for a check on C2="delivered" you haven't specified which worksheet to check C2 on , I have presumed sheet 2
2: you ask for a check on C2, which seems unlikely I have checked the value in column C for the row that matches the Id from sheets 1
3: you have asked if C2="delivered" that nothing is copied into column D, but you haven't specified whether I should or shouldn't copy stuff into column C , I presumed not.
4:To extract the data from the front of the string in column T I have changed the code to look for the first space in the string
try this:
VBA Code:
Sub test2()
Dim fullstr As String
With Worksheets("Sheet2")
lastup = .Cells(Rows.Count, "F").End(xlUp).Row ' find last row in column F of sheet 2
updt = Range(.Cells(1, 1), .Cells(lastup, 20)) ' pick columns A to T and all rows in sheet 2
' new mapping G is now F column 6
' H  is now X column 24
'I is now T column 20 Date is assumed to be all the characters up to the first space
End With
Worksheets("Sheet1").Select      ' lots of people say don't use select  but doing it once is quick and easy!!
lastmast = Cells(Rows.Count, "A").End(xlUp).Row
mastarr = Range(Cells(1, 1), Cells(lastmast, 4))

For i = 2 To lastmast
For j = 2 To lastup
  If mastarr(i, 1) = updt(j, 6) Then ' columnn F
  If updt(j, 3) = "delivered" Then
   mastarr(i, 3) = updt(j, 24) ' colunm X
   fullstr = updt(j, 20) ' Column I
   For kk = 1 To Len(fullstr)
    dt = Mid(fullstr, kk, 1)
    If dt = " " Then
      mastarr(i, 4) = Left(fullstr, kk - 1)
      Exit For
    End If
   Next kk
  End If
  End If
Next j
Next i
Range(Cells(1, 1), Cells(lastmast, 4)) = mastarr

offthelip
Thank you for your reply.
Also, I really appreciate you providing the explanations on each line. It really aids my comprehension while I am learning.

In a nutshell: Update Sheet1 (master sheet) based on updates from Sheet2.
I have provided some explanations to your post as well as a photo, to help clarify. My apologies for the previous confusion.

Your requirements aren't quite clear:
1: you ask for a check on C2="delivered" you haven't specified which worksheet to check C2 on , I have presumed sheet 2
ANSWER: Correct assumption. It would check column X on sheet2 and if update Column C sheet1.
2: you ask for a check on C2, which seems unlikely I have checked the value in column C for the row that matches the Id from sheets 1
3: you have asked if C2="delivered" that nothing is copied into column D, but you haven't specified whether I should or shouldn't copy stuff into column C , I presumed not.
ANSWER: If Sheet2 column X shows 'DELIVERED" only then will it find the date string in Sheet2 Column T to enter into Sheet1 D, and update column C. Only if X=DELIVERED & RECEIVED will update Sheet1 D. If X= anything else, then do not update Sheet1 D.
4:To extract the data from the front of the string in column T I have changed the code to look for the first space in the string
ANSWER: I think the previous search worked well for finding the date, but if you believe this works better, I will go with your decision.
I attempted to make some changes in your original code below, but I think I messed up and confused myself:(.

VBA Code:
Sub test2()
Dim fullstr As String
With Worksheets("Sheet2")
lastup = .Cells(Rows.Count, "F").End(xlUp).Row ' find last row in column F of sheet 2
updt = Range(.Cells(1, 1), .Cells(lastup, 24)) ' pick columns A to X and all rows in sheet 2
' new mapping G is now F column 6
' H  is now X column 24
'I is now T column 20 Date is assumed to be all the characters up to the first space
End With
Worksheets("Sheet1").Select      ' lots of people say don't use select  but doing it once is quick and easy!!
lastmast = Cells(Rows.Count, "A").End(xlUp).Row
mastarr = Range(Cells(1, 1), Cells(lastmast, 4))

For i = 2 To lastmast
For j = 2 To lastup
  If mastarr(i, 1) = updt(j, 6) Then ' Column F
  If updt(j, 3) = "delivered" Then
   mastarr(i, 3) = updt(j, 24) ' Column X ON SHEET2?
   fullstr = updt(j, 20) ' Column I??
   For kk = 1 To Len(fullstr)
    dt = Mid(fullstr, kk, 1)
    If dt = " " Then
      mastarr(i, 4) = Left(fullstr, kk - 1)
      Exit For
    End If
   Next kk
  End If
  End If
Next j
Next i
Range(Cells(1, 1), Cells(lastmast, 4)) = mastarr
End Sub
 

Attachments

  • Update sheets.JPG
    Update sheets.JPG
    124.1 KB · Views: 24
Upvote 0
Your requirements are still unclear, let me try and write them as I understand them at the moment ( this includes some guesses on my part!!) :

1: Sheet 1 columns A to D contain the master data that needs to be updated from updates contained on sheet 2
2; On the master sheet the columns are Tracking, Date sent, Status and Date Received
3: Updates are held on sheet 2 , column F is tracking which is used to match the tracking on sheet, Column X is Status and Column T is a string that contains a date
4: Updates to sheet 1 are to be made for every row on sheet 2 where column T contains "Delivered" or "Received" and the tracking string matches on both sheets.
5: If column T contains "Received" then the status on sheet 1 is updated to "Received" but the "Date Received" column ( col D) is not changed
6: If Column T contains "Delivered" then the text in column T is inspected to find the first date in the string and this date is used to update the Date Received on sheets 1
Is this correct, if not please correct the requirements,
 
Upvote 0
Hi offthelip. You did pretty good with your guesses. I made some corrections below. Thank you for your help. It really helps me to understand more.

1: Sheet 1 columns A to D contain the master data that needs to be updated from updates contained on sheet 2 (CORRECT)
2; On the master sheet the columns are Tracking, Date sent, Status and Date Received (CORRECT)
3: Updates are held on sheet 2 , column F is tracking which is used to match the tracking on sheet, Column X is Status and Column T is a string that contains a date (CORRECT)
4: Updates to sheet 1 are to be made for every row on sheet 2 where column T contains "Delivered" or "Received" and the tracking string matches on both sheets.
(CORRECTION: Updates to sheet1 are to be made on sheet2 for every row. In the event that column X contains "Delivered" or "Received", then the tracking string will be extracted from column T to be entered in sheet1 column D and update Column C with the status from Column X. If column X contains anything else, such as IN PROGRESS, then no date is required to be updated on sheet1 column D, just the status sheet1 column C needs to be updated.)
5: If column T contains "Received" then the status on sheet 1 is updated to "Received" but the "Date Received" column ( col D) is not changed
(CORRECTION: Correct. But Date will be updated as well in Column D.)
6: If Column T contains "Delivered" then the text in column T is inspected to find the first date in the string and this date is used to update the Date Received on sheets 1
Is this correct, if not please correct the requirements,
(CORRECT. It will update sheet1 column C & D.)
 
Upvote 0
I hope that has made you realise how important it is to write clear , unambiguous and complete requirements.
I have updated the code according to the last statement of the requirements. I have also changed the way I detected the date. because I realised that the way I detected the date ( i the first example) depended on the date string always being 9 characters long, however this is not always the case 1/2/2020 is 8 characters long and 12/12/2020 is 10 characters long.
so I have changed the code so it first looks for the first number in the string and once it has found that it looks for the first character which ISN'T a number or a slash, or the end of the string. and uses that to extract the length of the date string. This does depend on the date being entered with the delimiter being a slash /. ie. it won't detect dates like:
2:2:2020 or 2\2\2020 or 23 jan 2020 .
I have also when checking for delivered or received I convert it to uppercase so it will detect Delivered, delivered and DELIVERED, or even DeLivered as all meeting the criteria. Same with received.
try this:
VBA Code:
Sub test3()
Dim fullstr As String
With Worksheets("Sheet2")
lastup = .Cells(Rows.Count, "F").End(xlUp).Row ' find last row in column F of sheet 2
updt = Range(.Cells(1, 1), .Cells(lastup, 24)) ' pick columns A to X and all rows in sheet 2
' new mapping G is now F column 6
' H  is now X column 24
'I is now T column 20 Date is assumed to be all the characters up to the first space
End With
Worksheets("Sheet1").Select      ' lots of people say don't use select  but doing it once is quick and easy!!
lastmast = Cells(Rows.Count, "A").End(xlUp).Row
mastarr = Range(Cells(1, 1), Cells(lastmast, 4))

For i = 2 To lastmast
For j = 2 To lastup
  If mastarr(i, 1) = updt(j, 6) Then ' Column F
  mastarr(i, 3) = updt(j, 24) ' update status for all rows
  ' convert update status to upper case for comparison
   sts = StrConv(updt(j, 24), vbUpperCase)
  If sts = "DELIVERED" Or sts = "RECEIVED" Then
   fullstr = updt(j, 20) ' Column T
    startstr = -1
    endstr = Len(fullstr)
    For kk = 1 To Len(fullstr)
        digt = Mid(fullstr, kk, 1)
        If IsNumeric(digt) And startstr < 0 Then ' check for the first number in the string
           startstr = kk   ' set this to start of the string
        End If
        digasc = Asc(digt)   ' convert the curent character to ascii
        If startstr > 0 And (digasc > 57 Or digasc < 47) Then ' this checks whether the digit is a number or /
         endstr = kk ' set then end of the string as the first character which isn't a number or a slash
         Exit For
        End If
    Next kk
      If startstr > 0 Then
      dt = Mid(fullstr, startstr, endstr - startstr + 1)
      mastarr(i, 4) = dt
      End If
  End If
  End If
Next j
Next i
Range(Cells(1, 1), Cells(lastmast, 4)) = mastarr
End Sub
 
Upvote 0
I hope that has made you realise how important it is to write clear , unambiguous and complete requirements.
I have updated the code according to the last statement of the requirements. I have also changed the way I detected the date. because I realised that the way I detected the date ( i the first example) depended on the date string always being 9 characters long, however this is not always the case 1/2/2020 is 8 characters long and 12/12/2020 is 10 characters long.
so I have changed the code so it first looks for the first number in the string and once it has found that it looks for the first character which ISN'T a number or a slash, or the end of the string. and uses that to extract the length of the date string. This does depend on the date being entered with the delimiter being a slash /. ie. it won't detect dates like:
2:2:2020 or 2\2\2020 or 23 jan 2020 .
I have also when checking for delivered or received I convert it to uppercase so it will detect Delivered, delivered and DELIVERED, or even DeLivered as all meeting the criteria. Same with received.
try this:
VBA Code:
Sub test3()
Dim fullstr As String
With Worksheets("Sheet2")
lastup = .Cells(Rows.Count, "F").End(xlUp).Row ' find last row in column F of sheet 2
updt = Range(.Cells(1, 1), .Cells(lastup, 24)) ' pick columns A to X and all rows in sheet 2
' new mapping G is now F column 6
' H  is now X column 24
'I is now T column 20 Date is assumed to be all the characters up to the first space
End With
Worksheets("Sheet1").Select      ' lots of people say don't use select  but doing it once is quick and easy!!
lastmast = Cells(Rows.Count, "A").End(xlUp).Row
mastarr = Range(Cells(1, 1), Cells(lastmast, 4))

For i = 2 To lastmast
For j = 2 To lastup
  If mastarr(i, 1) = updt(j, 6) Then ' Column F
  mastarr(i, 3) = updt(j, 24) ' update status for all rows
  ' convert update status to upper case for comparison
   sts = StrConv(updt(j, 24), vbUpperCase)
  If sts = "DELIVERED" Or sts = "RECEIVED" Then
   fullstr = updt(j, 20) ' Column T
    startstr = -1
    endstr = Len(fullstr)
    For kk = 1 To Len(fullstr)
        digt = Mid(fullstr, kk, 1)
        If IsNumeric(digt) And startstr < 0 Then ' check for the first number in the string
           startstr = kk   ' set this to start of the string
        End If
        digasc = Asc(digt)   ' convert the curent character to ascii
        If startstr > 0 And (digasc > 57 Or digasc < 47) Then ' this checks whether the digit is a number or /
         endstr = kk ' set then end of the string as the first character which isn't a number or a slash
         Exit For
        End If
    Next kk
      If startstr > 0 Then
      dt = Mid(fullstr, startstr, endstr - startstr + 1)
      mastarr(i, 4) = dt
      End If
  End If
  End If
Next j
Next i
Range(Cells(1, 1), Cells(lastmast, 4)) = mastarr
End Sub
YES, you are absolutely right about writing clear , unambiguous and complete requirements. You sound like a teacher.;)
Thank you so much for writing this for me so quickly as well. It worked brilliantly. I really do love the explanations you have after a line. Makes it so much easier to follow and understand. What does mastarr mean? I couldn't find it.
I am trying to comprehend fully, each and every line you wrote, so I can understand it completely before I move on to another project. I did write another post around the same time I posted this original one. Nobody knows the answer yet though:(
offthelip, you are amazing!
 
Upvote 0

Forum statistics

Threads
1,213,529
Messages
6,114,155
Members
448,554
Latest member
Gleisner2

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