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
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