excelvbasearchsplitgroup

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


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

Solution

  • 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