VBA Loop - Christmas Brain

[mole999]

Not sure if I have seen this solved or asked before

I have a variable set of values with a key (X0001 to Y1600 currently) downloaded from SQL, against each key is a set of values. I have a table that I want to update when a key with value would not have current data

I would have done something like this but this works on rows

    For n = StartLookup To EndLookup Step 1
        
       ' If Range("S" & n) = "A4 A/S" And Range("AG" & n) = "" Then Range("U" & n) = "NORTHERN PERIMETER ROAD": Range("Y" & n) = "TW6 2RR": Range("AG" & n) = "53Q 106": Range("AH" & n) = "507158": Range("AI" & n) = "176822"
       ' If Range("S" & n) = "A4+" And Range("AG" & n) = "" Then Range("U" & n) = "NORTHERN PERIMETER ROAD": Range("Y" & n) = "TW6": Range("AG" & n) = "53Q 106": Range("AH" & n) = "507158": Range("AI" & n) = "176822"
Next n

So I want to work down X0001 to Y1600 and where in column B I have a value and on another sheet I have an associated blank I want to place the value in the blank

Any ideas that I can work with (I don't even know what would be good search terms (apart from VBA and LOOP)

 

[mole999]

My poor solution (slow)

Sub WORKINGX()
    On Error Resume Next
Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim N
    Dim finderA
    Dim TargetRowB
    Dim TargetRowA
    For N = 1 To 2209 Step 1
        finderA = "X" & Format(N, "0000")
        
        With Worksheets("Master Streets")
            .Select
            .Columns("D:D").Find(What:=finderA, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByColumns).Activate
            TargetRowA = ActiveCell.Row
        End With
       
        With Worksheets("Liability & Location")
            .Select
            .Columns("A:A").Find(What:=finderA, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByColumns).Activate
            TargetRowB = ActiveCell.Row
        End With
        'CAD
        If Worksheets("Master Streets").Range("I" & TargetRowA) = "" Then Worksheets("Master Streets").Range("I" & TargetRowA).Value = Worksheets("Liability & Location").Range("H" & TargetRowB).Value
        'ID
        If Worksheets("Master Streets").Range("O" & TargetRowA) = "" Then Worksheets("Master Streets").Range("O" & TargetRowA).Value = Worksheets("Liability & Location").Range("D" & TargetRowB).Value
        'Time
        If Worksheets("Master Streets").Range("H" & TargetRowA) = "" Then Worksheets("Master Streets").Range("H" & TargetRowA).Value = Worksheets("Liability & Location").Range("G" & TargetRowB).Value
        'Fleet
        If Worksheets("Master Streets").Range("E" & TargetRowA) = 0 Then Worksheets("Master Streets").Range("E" & TargetRowA).Value = Worksheets("Liability & Location").Range("E" & TargetRowB).Value
        If Worksheets("Master Streets").Range("J" & TargetRowA) <> Worksheets("Liability & Location").Range("B" & TargetRowB) Then Worksheets("Master Streets").Range("J" & TargetRowA).Value = Worksheets("Liability & Location").Range("B" & TargetRowB).Value
        DoEvents
        Application.StatusBar = N
    Next
Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub

I couldn't get it to work without using far too many selects and activates (kept throwing errors), any suggestion welcomed, to reduce these down

 

[Fluff]

How about

Sub WORKINGX()
'    On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
   Dim N As Long
   Dim MstWs As Worksheet
   Dim finderA As String
   Dim TargetB As Range
   Dim TargetA As Range
   
   Set MstWs = Worksheets("Master Streets")
   
   For N = 1 To 2209 Step 1
      finderA = "X" & Format(N, "0000")
      
      Set TargetA = MstWs.Columns("D:D").Find(What:=finderA, LookIn:=xlValues, _
         LookAt:=xlWhole, SearchOrder:=xlByColumns)
      [COLOR=#0000ff]If TargetA Is Nothing Then
         MsgBox finderA & " Not found in Master"
         Exit Sub
      End If[/COLOR]
      
      With Worksheets("Liability & Location")
         Set TargetB = .Columns("A:A").Find(What:=finderA, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns)
         [COLOR=#0000ff]If TargetB Is Nothing Then
            MsgBox finderA & " Not found in Liability"
            Exit Sub
         End If[/COLOR]
         'CAD
         If TargetA.Offset(, 5) = "" Then TargetA.Offset(, 5).Value = .Range("H" & TargetB.Row).Value
         'ID
         If TargetA.Offset(, 11) = "" Then TargetA.Offset(, 11).Value = .Range("D" & TargetB.Row).Value
         'Time
         If TargetA.Offset(, 4) = "" Then TargetA.Offset(, 4).Value = .Range("G" & TargetB.Row).Value
         'Fleet
         If TargetA.Offset(, 1) = 0 Then TargetA.Offset(, 1).Value = .Range("E" & TargetB.Row).Value
         If TargetA.Offset(, 6) <> .Range("B" & TargetB.Row) Then TargetA.Offset(, 6).Value = .Range("B" & TargetB.Row).Value
         DoEvents
         Application.StatusBar = N
      End With
   Next
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Wasn't sure what you wanted to do if the Xnumber wasn't found, so put a couple of checks in place

 

[Fluff]

Alternatively, if you want to compare the whole of col D on Master Streets , with the whole of col A on Liability & Location
Try

Sub WorkingX_2()

   Dim Cl As Range
   Dim MstWs As Worksheet
   Dim LLws As Worksheet

Application.ScreenUpdating = False
   
   Set MstWs = Worksheets("Master Streets")
   Set LLws = Worksheets("Liability & Location")

   With CreateObject("scripting.dictionary")
      For Each Cl In LLws.Range("A2", LLws.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Array(Cl.Offset(, 7).Value, Cl.Offset(, 3).Value, Cl.Offset(, 6).Value, Cl.Offset(, 4).Value, Cl.Offset(, 1).Value)
      Next Cl
      For Each Cl In MstWs.Range("D2", MstWs.Range("D" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            If Cl.Offset(, 5) = "" Then Cl.Offset(, 5).Value = .Item(Cl.Value)(0)
            If Cl.Offset(, 11) = "" Then Cl.Offset(, 11).Value = .Item(Cl.Value)(1)
            If Cl.Offset(, 4) = "" Then Cl.Offset(, 4).Value = .Item(Cl.Value)(2)
            If Cl.Offset(, 1) = 0 Then Cl.Offset(, 1).Value = .Item(Cl.Value)(3)
            If Cl.Offset(, 6) <> .Item(Cl.Value)(4) Then Cl.Offset(, 6).Value = .Item(Cl.Value)(4)
         End If
      Next Cl
   End With
End Sub

 

[mole999]

@Fluff
Thank you
X is limited as a closed year so I know the values 1 to 2209 (there is no expectation of any missed values, but that's why ON Error is in there)
Y is worked out from a main cell reference that identifies the highest AlphaNumeric Value from the range, being updated as I draw in more data
the main sheet is over 25K values, about 40 cols, and check values are from SQL for what I want to test for.
The data from SQL would be sequential, the masters list could be in any one of five sort orders, hence checking the incremental value and identifying which row on both sheets the start value resides
I only need to do data cross checks infrequently, but its laborious line by line with Index Match and filters, then manual updates of individual cells

 

[Fluff]

Are you saying that my suggestions didn't work?

 

[mole999]

Are you saying that my suggestions didn't work?

no, i didn't say they didn't work, I was attempting to demonstrate the range involved and that it isn't sequential or contiguous. your first script i tried last night and it worked as i expected. as yet i haven't tried the second variant

 

[mole999]

Now had time to implement and test the latest version and it does everything I could have hoped for, thank you

 

[Fluff]

Glad to help & thanks for the feedback