Editing VBA code to get information by keyword and not offset function due to varying cell places

I

Indominus

Board Regular
Joined
Jul 11, 2020
Messages
160
Office Version
  1. 2016
Platform
  1. Windows
Hello. I have two workbooks. Pickorder and DWP. Both have the same route codes listed (Ex. CR1) However, only one (DWP) lists the DSP that will be taking the route. So this code identifies the matching route codes and on the DWP sheet grabs the value in the left cell which is the dsp and pastes it into the Pickorder workbook. Does this by using the Offset function. The problem is I got a new sheet that has more information and now the dsp can be in random cell in the DWP sheet. It no longer always is in the cell to the left of the route code. It will be below the route and the cell will always be titled (DSP: LISTS THE DSP HERE). Example being DSP: HIQL. How can I edit this VBA code to look below the route code and the first cell that contains "DSP:" grab the value after the colon? Attached is a picture showing how it is laid out. In this case CR1 and CR2 should both grab HIQL. Also here is the code. The following line is the one that grabs it and pastes it into pickorder and I believe is the key one that needs to be edited. Thank you to anyone willing to help.

PO.Range("E" & tRow).Value = sq.Offset(0, -1).Value

VBA Code: 
Option Compare Text
                      
                        Sub DWPMatchDSP()
                            'CLICK HERE AND PRESS F5 TO START SCRIPT
                           
                           
                            For Each w In Workbooks
                            If UCase(w.Name) Like UCase("*Pick*order*") Then
                            Windows(w.Name).Activate
                            Exit For
                            End If
                            Next w
                           
                     
                       
                            Dim dsp As Workbook         'DISPATCH
                            Dim dwp As Workbook        'DWP
                            Dim rngDSP As Range         'DWP RANGE
                            Dim sq As Range             'SPARE RANGE
                            Dim PO As Worksheet         'PICKORDER SHEET
                            Dim i As Long               'ITERATION
                       
                             'FIND PICKORDER WORKBOOK & SHEET
                            
                                For i = 1 To Workbooks.Count
                                    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
                                Set dsp = Workbooks(i)
                                Exit For
                            End If
                                Next i
                           
                                For i = 1 To dsp.Worksheets.Count
                                   If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
                                Set dsp = Workbooks(i)
                                Exit For
                            End If
                                        Set PO = dsp.Sheets(Worksheets(i).Name)
                                   
                                Next i
                       
                       
                            'SET OTHER OBJECTS
                            Set dwp = Workbooks("DWP.xlsm")
                            Set rngDSP = dwp.Sheets("DWP").Range("B1:B5000")
                       
                       
                       
                            Dim RC As String            'ROUTE CODE
                            Dim tRow As Long            'TARGET ROW
                            Dim LastRow As Long         'LAST ROW
                       
                            LastRow = PO.Range("B1").End(xlDown).Row
                       
                            'PROCEED DOWN COLUMN B LOOKING FOR DATA TO UPDATE
                            For tRow = 2 To LastRow
                                'DEFINE ROUTE CODE
                                RC = PO.Range("B" & tRow).Value
                       
                                'LOOK THROUGH DWP FOR MATCHING ROUTE CODE
                                For Each sq In rngDSP
                       
                                    'IF FOUND
                                    If sq.Value = RC Then
                       
                                        'COPY ROW BELOW FOUND ROUTE CODE TO COLUMN A OF DISPATCH
                                       
               
                PO.Range("E" & tRow).Value = sq.Offset(0, -1).Value
                       
                                    End If
                                Next sq
                            Next tRow
                       
                  
                       
                        End Sub
 

Attachments

  • Pick List Excel.JPG
    Pick List Excel.JPG
    108.5 KB · Views: 21

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
Indominus

Having identified the cell that contains the route code you can then use the Find method to search from that cell downwards to look for a cell that contains the string "DSP". You need to create a range variable to put the result of the Find into and then use the Value of the Range.
VBA Code: 
dim DSPName as Range
Set DSPName = PO.Range(PO.Cells(trow,2),PO.Cells(lastrow,2)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
PO.Range("E" & tRow).Value = DSPName.Value
 
Upvote 0
ExcelGzh said:
Indominus

Having identified the cell that contains the route code you can then use the Find method to search from that cell downwards to look for a cell that contains the string "DSP". You need to create a range variable to put the result of the Find into and then use the Value of the Range.
VBA Code: 
dim DSPName as Range
Set DSPName = PO.Range(PO.Cells(trow,2),PO.Cells(lastrow,2)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
PO.Range("E" & tRow).Value = DSPName.Value
Click to expand...
Hello ExcelGzh. Thank you for the response. So I tried adding this but I am a bit confused on where to add it into my code. It seems after it identifies and matches up route codes so I added it to the end. Doing this however, gives me error 91, "Object variable or with block variable not set." On line

PO.Range("E" & tRow).Value = DSPName.Value

Here is the code I am using with yours at the end. I also edited the DWP sheets range to "B1:B500" since that is the entire range of the data in there. Thank you!

VBA Code: 
    Option Compare Text
                    
                        Sub DWPMatchDSP()
                            'CLICK HERE AND PRESS F5 TO START SCRIPT
                         
                         
                            For Each w In Workbooks
                            If UCase(w.Name) Like UCase("*Pick*order*") Then
                            Windows(w.Name).Activate
                            Exit For
                            End If
                            Next w
                         
                            Range("E1").Value = "dsp"
                         
                 
             
                         
                             
                         
                     
                            Dim dsp As Workbook         'DISPATCH
                            Dim dwp As Workbook        'DWP
                            Dim rngDSP As Range         'DWP RANGE
                            Dim sq As Range             'SPARE RANGE
                            Dim PO As Worksheet         'PICKORDER SHEET
                            Dim i As Long               'ITERATION
                     
                             'FIND PICKORDER WORKBOOK & SHEET
                          
                                For i = 1 To Workbooks.Count
                                    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
                                Set dsp = Workbooks(i)
                                Exit For
                            End If
                                Next i
                         
                                For i = 1 To dsp.Worksheets.Count
                                   If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
                                Set dsp = Workbooks(i)
                                Exit For
                            End If
                                        Set PO = dsp.Sheets(Worksheets(i).Name)
                                 
                                Next i
                     
                     
                            'SET OTHER OBJECTS
                            Set dwp = Workbooks("DWP.xlsm")
                            Set rngDSP = dwp.Sheets("DWP").Range("A1:A5000")
                     
                     
                     
                            Dim RC As String            'ROUTE CODE
                            Dim tRow As Long            'TARGET ROW
                            Dim LastRow As Long         'LAST ROW
                     
                            LastRow = PO.Range("B1").End(xlDown).Row
                     
                            'PROCEED DOWN COLUMN B LOOKING FOR DATA TO UPDATE
                            For tRow = 2 To LastRow
                                'DEFINE ROUTE CODE
                                RC = PO.Range("B" & tRow).Value
                     
                                'LOOK THROUGH DWP FOR MATCHING ROUTE CODE
                                For Each sq In rngDSP
                     
                                    'IF FOUND
                                    If sq.Value = RC Then
                     
                                        'COPY ROW BELOW FOUND ROUTE CODE TO COLUMN A OF DISPATCH
                                     
             
                Dim DSPName As Range
             
Set DSPName = PO.Range(PO.Cells(tRow, 2), PO.Cells(LastRow, 2)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

PO.Range("E" & tRow).Value = DSPName.Value
                     
                                    End If
                                Next sq
                            Next tRow
                     
                     
                     

                     
                     
                        End Sub
 
Upvote 0
ExcelGzh said:
Indominus

Having identified the cell that contains the route code you can then use the Find method to search from that cell downwards to look for a cell that contains the string "DSP". You need to create a range variable to put the result of the Find into and then use the Value of the Range.
VBA Code: 
dim DSPName as Range
Set DSPName = PO.Range(PO.Cells(trow,2),PO.Cells(lastrow,2)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
PO.Range("E" & tRow).Value = DSPName.Value
Click to expand...
Hi, upon playing around with this more including the placement of the code I got it to run completely without errors however it only matches up the route codes and pastes those into the Pickorder. It does not grab the value after the phrase "DSP:" Here are a couple of screenshots showing what it did versus what I am looking for. Also here is the new format of the code I have.

VBA Code: 
    Option Compare Text
                       
                        Sub DWPMatchDSP()
                            'CLICK HERE AND PRESS F5 TO START SCRIPT
                            
                            
                            For Each w In Workbooks
                            If UCase(w.Name) Like UCase("*Pick*order*") Then
                            Windows(w.Name).Activate
                            Exit For
                            End If
                            Next w
                            
                            
                            
                                
                            
                        
                            Dim dsp As Workbook         'DISPATCH
                            Dim dwp As Workbook        'DWP
                            Dim rngDSP As Range         'DWP RANGE
                            Dim sq As Range             'SPARE RANGE
                            Dim PO As Worksheet         'PICKORDER SHEET
                            Dim i As Long               'ITERATION
                        
                             'FIND PICKORDER WORKBOOK & SHEET
                             
                                For i = 1 To Workbooks.Count
                                    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
                                Set dsp = Workbooks(i)
                                Exit For
                            End If
                                Next i
                            
                                For i = 1 To dsp.Worksheets.Count
                                   If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
                                Set dsp = Workbooks(i)
                                Exit For
                            End If
                                        Set PO = dsp.Sheets(Worksheets(i).Name)
                                    
                                Next i
                        
                        
                            'SET OTHER OBJECTS
                            Set dwp = Workbooks("MCO Routing Macro.xlsm")
                            Set rngDSP = dwp.Sheets("DWP").Range("A1:A5000")
                            Dim DSPName As Range
                        
                        
                        
                            Dim RC As String            'ROUTE CODE
                            Dim tRow As Long            'TARGET ROW
                            Dim LastRow As Long         'LAST ROW
                            

                            
                        
                            LastRow = PO.Range("B1").End(xlDown).Row
                            
                        
                            'PROCEED DOWN COLUMN B LOOKING FOR DATA TO UPDATE
                            For tRow = 2 To LastRow
                                'DEFINE ROUTE CODE
                                RC = PO.Range("B" & tRow).Value
                                
                                'DSP Name
                                
                                Set DSPName = PO.Range(PO.Cells(tRow, 2), PO.Cells(LastRow, 2)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
                        
                                'LOOK THROUGH DWP FOR MATCHING ROUTE CODE
                                For Each DSPName In rngDSP
                                
                        
                                    'IF FOUND
                                    If DSPName.Value = RC Then
                        
                                        'COPY ROW BELOW FOUND ROUTE CODE TO COLUMN A OF DISPATCH
                                        
                
                PO.Range("E" & tRow).Value = DSPName.Value
                        
                                    End If
                                Next DSPName
                            Next tRow
                        
                        
                        
                      
                        
                        
                        End Sub
 

Attachments

  • CodeMatchingRouteCodesJPG.JPG
    CodeMatchingRouteCodesJPG.JPG
    186.9 KB · Views: 15
  • WhatCodeShouldPull.JPG
    WhatCodeShouldPull.JPG
    181.5 KB · Views: 15
Upvote 0
Indominus

I think this will do what you need. I have also made other modifications to the code. Read the comments to see what I have done. Once you have worked out what I have done it would be best to delete the redundant lines and my comments.

VBA Code: 
Sub DWPMatchDSP()
  'CLICK HERE AND PRESS F5 TO START SCRIPT
  
  'Redundant code except for Activate.  The variable w is used nowhere else.  Transferred the Activate line to the next block of code.
'  For Each w In Workbooks
'    If UCase(w.Name) Like UCase("*Pick*order*") Then
'      Windows(w.Name).Activate
'      Exit For
'    End If
'  Next w
  
  Range("E1").Value = "dsp" 'Not sure what this for
  
  Dim dsp As Workbook         'DISPATCH
  Dim dwp As Workbook        'DWP
  Dim rngDSP As Range         'DWP RANGE
  Dim sq As Range             'SPARE RANGE
  Dim PO As Worksheet         'PICKORDER SHEET
  Dim i As Long               'ITERATION
  
  'FIND PICKORDER WORKBOOK & SHEET
  
  For i = 1 To Workbooks.Count
    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
      Set dsp = Workbooks(i)
      dsp.Activate 'Transferred from block above
      Exit For
    End If
  Next i
  
  For i = 1 To dsp.Worksheets.Count
      'Need to search sheets not workbooks
'    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
    If InStr(1, Worksheets(i).Name, "Pickorder", vbTextCompare) <> 0 Then
'      Set dsp = Workbooks(i)
      Set PO = dsp.Worksheets(i) 'Transferred from outside For-Next loop
      Exit For
    End If
      'Only set PO if name "Pickorder" found - move to inside For-Next loop
'    Set PO = dsp.Sheets(Worksheets(i).Name)
  Next i
  
  'SET OTHER OBJECTS
  Set dwp = Workbooks("DWP.xlsm")
  Set rngDSP = dwp.Sheets("DWP").Range("A1:A5000")
  
  Dim RC As String            'ROUTE CODE
  Dim tRow As Long            'TARGET ROW
  Dim LastRow As Long         'LAST ROW
  Dim DSPName As Range 'Declaring here means it is only declared once instead of every time the loop is executed
  
  LastRow = PO.Range("B1").End(xlDown).Row
  
  'PROCEED DOWN COLUMN B LOOKING FOR DATA TO UPDATE
  For tRow = 2 To LastRow
    'DEFINE ROUTE CODE
    RC = PO.Range("B" & tRow).Value
    
    'LOOK THROUGH DWP FOR MATCHING ROUTE CODE
    For Each sq In rngDSP
      'IF FOUND
      If sq.Value = RC Then
        'COPY ROW BELOW FOUND ROUTE CODE TO COLUMN A OF DISPATCH
'        Dim DSPName As Range  **Move out of loop so it doesn't get re-declared every time the loop executes
        
        'This line is looking in the wrong workbook
'        Set DSPName = PO.Range(PO.Cells(tRow, 2), PO.Cells(LastRow, 2)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
        Set DSPName = dwp.Sheets("DWP").Range(dwp.Sheets("DWP").Cells(sq.Row, 1), dwp.Sheets("DWP").Cells(500, 1)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
'        PO.Range("E" & tRow).Value = DSPName.Value
        PO.Range("E" & tRow).Value = Right(DSPName, Len(DSPName.Value) - 4)  'This line ignores the first 4 characters DSP:
      End If
    Next sq
  Next tRow
  
End Sub
 
Upvote 0
ExcelGzh said:
Indominus

I think this will do what you need. I have also made other modifications to the code. Read the comments to see what I have done. Once you have worked out what I have done it would be best to delete the redundant lines and my comments.

VBA Code: 
Sub DWPMatchDSP()
  'CLICK HERE AND PRESS F5 TO START SCRIPT
 
  'Redundant code except for Activate.  The variable w is used nowhere else.  Transferred the Activate line to the next block of code.
'  For Each w In Workbooks
'    If UCase(w.Name) Like UCase("*Pick*order*") Then
'      Windows(w.Name).Activate
'      Exit For
'    End If
'  Next w
 
  Range("E1").Value = "dsp" 'Not sure what this for
 
  Dim dsp As Workbook         'DISPATCH
  Dim dwp As Workbook        'DWP
  Dim rngDSP As Range         'DWP RANGE
  Dim sq As Range             'SPARE RANGE
  Dim PO As Worksheet         'PICKORDER SHEET
  Dim i As Long               'ITERATION
 
  'FIND PICKORDER WORKBOOK & SHEET
 
  For i = 1 To Workbooks.Count
    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
      Set dsp = Workbooks(i)
      dsp.Activate 'Transferred from block above
      Exit For
    End If
  Next i
 
  For i = 1 To dsp.Worksheets.Count
      'Need to search sheets not workbooks
'    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
    If InStr(1, Worksheets(i).Name, "Pickorder", vbTextCompare) <> 0 Then
'      Set dsp = Workbooks(i)
      Set PO = dsp.Worksheets(i) 'Transferred from outside For-Next loop
      Exit For
    End If
      'Only set PO if name "Pickorder" found - move to inside For-Next loop
'    Set PO = dsp.Sheets(Worksheets(i).Name)
  Next i
 
  'SET OTHER OBJECTS
  Set dwp = Workbooks("DWP.xlsm")
  Set rngDSP = dwp.Sheets("DWP").Range("A1:A5000")
 
  Dim RC As String            'ROUTE CODE
  Dim tRow As Long            'TARGET ROW
  Dim LastRow As Long         'LAST ROW
  Dim DSPName As Range 'Declaring here means it is only declared once instead of every time the loop is executed
 
  LastRow = PO.Range("B1").End(xlDown).Row
 
  'PROCEED DOWN COLUMN B LOOKING FOR DATA TO UPDATE
  For tRow = 2 To LastRow
    'DEFINE ROUTE CODE
    RC = PO.Range("B" & tRow).Value
   
    'LOOK THROUGH DWP FOR MATCHING ROUTE CODE
    For Each sq In rngDSP
      'IF FOUND
      If sq.Value = RC Then
        'COPY ROW BELOW FOUND ROUTE CODE TO COLUMN A OF DISPATCH
'        Dim DSPName As Range  **Move out of loop so it doesn't get re-declared every time the loop executes
       
        'This line is looking in the wrong workbook
'        Set DSPName = PO.Range(PO.Cells(tRow, 2), PO.Cells(LastRow, 2)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
        Set DSPName = dwp.Sheets("DWP").Range(dwp.Sheets("DWP").Cells(sq.Row, 1), dwp.Sheets("DWP").Cells(500, 1)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
'        PO.Range("E" & tRow).Value = DSPName.Value
        PO.Range("E" & tRow).Value = Right(DSPName, Len(DSPName.Value) - 4)  'This line ignores the first 4 characters DSP:
      End If
    Next sq
  Next tRow
 
End Sub
Click to expand...
Hi, thank you for your help. So I can into a couple of problems with this code. For some reason it is not recognizing or activating the Pickorder workbook. I added back in the original part of the code in the beginning and it works for some reason. Also the big thing is the code runs somewhat but during the execution it stops and produces the error code 91, "object variable or with block variable not set." On line PO.Range("E" & tRow).Value = Right(DSPName, Len(DSPName.Value) - 4) 'This line ignores the first 4 characters DSP:

It puts some DSPS into column E and in this case up to row 27. However, it only does one DSP. Does not seem like it matches the route code to its DSP. In this case it seems it is only going to get HIQL. I have uploaded both workbooks with the data included into Dropbox in hopes of providing more clarity on the situation. Also the DWP workbook has the DWP sheet on it with all the data. The macro with your code I am testing is titled PickListDSP. Thank you so much again for helping me. Pickorder
 
Upvote 0
Indominus

See below for revised code. I was able to populate all the rows of PickOrder with a dispatcher using the this code. You will need to check that the correct Dispatcher was assigned to each row.

VBA Code: 
Sub PickListDSP()

  Dim dsp As Workbook         'DISPATCH
  Dim dwp As Workbook        'DWP
  Dim rngDSP As Range         'DWP RANGE
  Dim sq As Range             'SPARE RANGE
  Dim PO As Worksheet         'PICKORDER SHEET
  Dim i As Long               'ITERATION
  Dim RC As String            'ROUTE CODE
  Dim tRow As Long            'TARGET ROW
  'Change LastRow to POLastRow to differentiate it from a new variable dspLastRow
  Dim POLastRow As Long         'LAST ROW of Pickorder sheet
  Dim dspLastRow As Long          'Last row of rngDSP range
  Dim DSPName As Range 'Declaring here means it is only declared once instead of every time the loop is executed
  
  'FIND PICKORDER WORKBOOK
  For Each w In Workbooks
    If UCase(w.Name) Like UCase("*Pick*order*") Then
      Windows(w.Name).Activate
      Set dsp = w
      Exit For
    End If
  Next w
  
  Range("E1").Value = "dsp"
  
  'FIND PICKORDER SHEET WITHIN PICKORDER WORKBOOK
  'Redundant loop.  This loop and the previous one were doing more or less the same thing
'  For i = 1 To Workbooks.Count
'    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
'      Set dsp = Workbooks(i)
'      Exit For
'    End If
'  Next i
  
  For i = 1 To dsp.Worksheets.Count
    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
'      Set dsp = Workbooks(i) **Moved to Find PickOrder Workbook
      Set PO = dsp.Sheets(Worksheets(i).Name)
      Exit For
    End If
  Next i
  
  'SET OTHER OBJECTS
'  Set dwp = Workbooks("DWP.xlsm")
'  Loop used to find DWP workbooks that have other text in workbook name
  For Each w In Workbooks
    If UCase(w.Name) Like UCase("*DWP*") Then
      Set dwp = w
      Exit For
    End If
  Next w
'  Set rngDSP = dwp.Sheets("DWP").Range("A1:A9000")
  'Instead of having a fixed range, make it dynamic by identifying the last row with End(xlUp), then use dspLastRow to define the range
  dspLastRow = dwp.Sheets("DWP").Cells(Rows.Count, 1).End(xlUp).Row
  Set rngDSP = dwp.Sheets("DWP").Range(dwp.Sheets("DWP").Cells(1, 1), dwp.Sheets("DWP").Cells(dspLastRow, 1))
'  LastRow = PO.Range("B1").End(xlDown).Row
  'Better to find last row by coming up from the bottom of the sheet instead of down from the first row
  'Up from the bottom will always find the last used cell whereas down from the top may get stopped by a blank cell in the middle of the list
  POLastRow = PO.Cells(Rows.Count, 2).End(xlUp).Row
  
  'PROCEED DOWN COLUMN B LOOKING FOR DATA TO UPDATE
  For tRow = 2 To POLastRow
    'DEFINE ROUTE CODE
    RC = PO.Range("B" & tRow).Value
    
    'LOOK THROUGH DWP FOR MATCHING ROUTE CODE
    For Each sq In rngDSP
      'IF FOUND
      If sq.Value = RC Then
        'COPY ROW BELOW FOUND ROUTE CODE TO COLUMN A OF DISPATCH
        '        Dim DSPName As Range  **Move out of loop so it doesn't get re-declared every time the loop executes
        
        'This line is looking in the wrong workbook
        '        Set DSPName = PO.Range(PO.Cells(tRow, 2), PO.Cells(LastRow, 2)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
        Set DSPName = dwp.Sheets("DWP").Range(dwp.Sheets("DWP").Cells(sq.Row, 1), dwp.Sheets("DWP").Cells(dspLastRow, 1)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
        '        PO.Range("E" & tRow).Value = DSPName.Value
        PO.Range("E" & tRow).Value = Trim(Right(DSPName, Len(DSPName.Value) - 4))
      End If
    Next sq
  Next tRow

End Sub
 
Upvote 0
Solution
ExcelGzh said:
Indominus

See below for revised code. I was able to populate all the rows of PickOrder with a dispatcher using the this code. You will need to check that the correct Dispatcher was assigned to each row.

VBA Code: 
Sub PickListDSP()

  Dim dsp As Workbook         'DISPATCH
  Dim dwp As Workbook        'DWP
  Dim rngDSP As Range         'DWP RANGE
  Dim sq As Range             'SPARE RANGE
  Dim PO As Worksheet         'PICKORDER SHEET
  Dim i As Long               'ITERATION
  Dim RC As String            'ROUTE CODE
  Dim tRow As Long            'TARGET ROW
  'Change LastRow to POLastRow to differentiate it from a new variable dspLastRow
  Dim POLastRow As Long         'LAST ROW of Pickorder sheet
  Dim dspLastRow As Long          'Last row of rngDSP range
  Dim DSPName As Range 'Declaring here means it is only declared once instead of every time the loop is executed
 
  'FIND PICKORDER WORKBOOK
  For Each w In Workbooks
    If UCase(w.Name) Like UCase("*Pick*order*") Then
      Windows(w.Name).Activate
      Set dsp = w
      Exit For
    End If
  Next w
 
  Range("E1").Value = "dsp"
 
  'FIND PICKORDER SHEET WITHIN PICKORDER WORKBOOK
  'Redundant loop.  This loop and the previous one were doing more or less the same thing
'  For i = 1 To Workbooks.Count
'    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
'      Set dsp = Workbooks(i)
'      Exit For
'    End If
'  Next i
 
  For i = 1 To dsp.Worksheets.Count
    If InStr(1, Workbooks(i).Name, "Pickorder", vbTextCompare) <> 0 Then
'      Set dsp = Workbooks(i) **Moved to Find PickOrder Workbook
      Set PO = dsp.Sheets(Worksheets(i).Name)
      Exit For
    End If
  Next i
 
  'SET OTHER OBJECTS
'  Set dwp = Workbooks("DWP.xlsm")
'  Loop used to find DWP workbooks that have other text in workbook name
  For Each w In Workbooks
    If UCase(w.Name) Like UCase("*DWP*") Then
      Set dwp = w
      Exit For
    End If
  Next w
'  Set rngDSP = dwp.Sheets("DWP").Range("A1:A9000")
  'Instead of having a fixed range, make it dynamic by identifying the last row with End(xlUp), then use dspLastRow to define the range
  dspLastRow = dwp.Sheets("DWP").Cells(Rows.Count, 1).End(xlUp).Row
  Set rngDSP = dwp.Sheets("DWP").Range(dwp.Sheets("DWP").Cells(1, 1), dwp.Sheets("DWP").Cells(dspLastRow, 1))
'  LastRow = PO.Range("B1").End(xlDown).Row
  'Better to find last row by coming up from the bottom of the sheet instead of down from the first row
  'Up from the bottom will always find the last used cell whereas down from the top may get stopped by a blank cell in the middle of the list
  POLastRow = PO.Cells(Rows.Count, 2).End(xlUp).Row
 
  'PROCEED DOWN COLUMN B LOOKING FOR DATA TO UPDATE
  For tRow = 2 To POLastRow
    'DEFINE ROUTE CODE
    RC = PO.Range("B" & tRow).Value
   
    'LOOK THROUGH DWP FOR MATCHING ROUTE CODE
    For Each sq In rngDSP
      'IF FOUND
      If sq.Value = RC Then
        'COPY ROW BELOW FOUND ROUTE CODE TO COLUMN A OF DISPATCH
        '        Dim DSPName As Range  **Move out of loop so it doesn't get re-declared every time the loop executes
       
        'This line is looking in the wrong workbook
        '        Set DSPName = PO.Range(PO.Cells(tRow, 2), PO.Cells(LastRow, 2)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
        Set DSPName = dwp.Sheets("DWP").Range(dwp.Sheets("DWP").Cells(sq.Row, 1), dwp.Sheets("DWP").Cells(dspLastRow, 1)).Find("DSP", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
        '        PO.Range("E" & tRow).Value = DSPName.Value
        PO.Range("E" & tRow).Value = Trim(Right(DSPName, Len(DSPName.Value) - 4))
      End If
    Next sq
  Next tRow

End Sub
Click to expand...
This works perfectly!!! Thank you so much ExcelGzh
 
Upvote 0
Always glad to be of assistance. Good luck with it all.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA Code Error Unable to get the Match property of the WorksheetFunction class
Replies
8
Views
177
Jiraya_00
J
D
  • Locked
  • Question Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
315
RoryA
RoryA
C
  • Solved
VBA Code to move Amount Due from individual sheets to a master sheet, and then copy information from the master sheet back to the individual sheets?
Replies
7
Views
378
Coyotex3
C
I
  • Question Question
Looping vba code until all relevant data ends?
Replies
2
Views
635
Indominus
I
F
  • Question Question
VBA run code based off cell value
Replies
1
Views
682
igold
igold

Forum statistics

Threads
1,223,229
Messages
6,170,881
Members
452,364
Latest member
springate

Share this page

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