Excel VBA search for data and stuck at a certain point due to group or split source file?

Question

I have below code which quite simple maybe not the most elegant but works well with a small mistake what I cannot handle. Source excel file is something which I am using with group and split in 4 on my screen due to better visibility. The problem I face with this code, when its run it stops, and there is a run-time error 1004. If I push debug I can see that sucks at first empty cell which represents this line "wsR.Range("U" & i).Select"...and if ungroup the section where code has to fulfill missing data, runs further in proper manner, fulfill details and close. I tried with built in ungroup command but not works. Thx for your help in advance

Sub Dates()

Dim wbDB, wbR As Workbook
Dim wsDB, wsR As Worksheet
Dim rngDB, rngR As Range

Set wbDB = Workbooks("DASHBOARD.xlsx")
Set wsDB = wbDB.Worksheets("Sheet1")
Set rngDB = wsDB.Range("A:V")

Set wbR = Workbooks("DATE.xlsm")
Set wsR = wbR.Worksheets("ENTRY")
Set rngR = wsR.Range("A:AK")

Dim j As Long
j = rngR(rngR.Rows.Count, "E").End(xlUp).row

For i = 2 To j
Dim lr As Long
lr = rngDB(rngDB.Rows.Count, "B").End(xlUp).row


RES = Application.Match(wsR.Range("E" & i).Value, wsDB.Range("B1:B" & lr), 0)

If Not IsError(RES) Then
        
                    
     
        If IsEmpty(wsR.Range("U" & i).Value) Then
            wsR.Range("U" & i).Value = wsDB.Range("R" & RES)
                wsR.Range("U" & i).Select
                    Selection.NumberFormat = "D-MMM"
                    
        End If
                                            
                
                    If IsEmpty(wsR.Range("W" & i).Value) Then
                        wsR.Range("W" & i).Value = wsDB.Range("S" & RES)
                            wsR.Range("W" & i).Select
                                Selection.NumberFormat = "D-MMM"
                    
                    End If

End If

Next i

End Sub

Answer 1

You don't need to select anything to fill a value or apply a number format.

Sub Dates()

    Dim wbDB, wbR As Workbook
    Dim wsDB, wsR As Worksheet
    Dim rngDB, rngR As Range, RES As Variant, rngMatch As Range
    Dim j As Long, i As Long, lr As Long
    
    Set wbDB = Workbooks("DASHBOARD.xlsx")
    Set wsDB = wbDB.Worksheets("Sheet1")
    
    Set wbR = Workbooks("DATE.xlsm") 'ThisWorkbook, if code is here
    Set wsR = wbR.Worksheets("ENTRY")
    
    Set rngMatch = wsDB.Range("B1", wsDB.Cells(wsDB.Rows.Count, "B").End(xlUp))
    
    For i = 2 To wsR.Cells(wsR.Rows.Count, "E").End(xlUp).Row
        RES = Application.Match(wsR.Range("E" & i).Value, rngMatch, 0)
        If Not IsError(RES) Then
            FillIfEmpty wsR.Range("U" & i), wsDB.Cells(RES, "R")
            FillIfEmpty wsR.Range("W" & i), wsDB.Cells(RES, "S")
        End If
    Next i

End Sub

'if rngDest has no value, apply numberformat and fill with value from rngSrc
Sub FillIfEmpty(rngDest As Range, rngSrc As Range)
    With rngDest
        If IsEmpty(.Value) Then
            .NumberFormat = "D-MMM"
            .Value = rngSrc.Value
        End If
    End With
End Sub

Worth reviewing this post to help you avoid select/activate: How to avoid using Select in Excel VBA