We help IT Professionals succeed at work.

Copy Data in Empty Cell

Cartillo
Cartillo asked
on
Hi Experts,

I would like to request Experts help create a macro which can  identify a blank cell of each start date in Week 1 to Week 5 sheets  (ignore if the start date has a data and the first date of the month) and copies this blank cell with the last data that was captured in the previous date.

E.g.1 Cell C4 (Week1) is empty, thus copy data from cell B271 (last data from the previous date) and paste it at C4
E.g.2 Cell D4 (week1) is empty, therefore copy data from cell C277 (with the color) and paste it at D4.
E.g.3 Cell B4 (week2) is empty, therefore copy data from cell H271 (last data from the previous date) and paste it at B4.

Hope Experts will help me create this feature. Attached the workbook for Experts perusal.



Merge-Cell.xls
Comment
Watch Question

Commented:
This will do what you want, I think
Sub Macro1()
    Dim weeknum As Integer
    Dim daynum As Integer
    
    ' Loop through each "Week" sheet
    For weeknum = 1 To 5
        Sheets("Week" & weeknum).Activate
        
        ' Loop through each day of the week
        For daynum = 3 To 8
        
            ' Check if the first row is blank
            ' if so, copy the value from the previous day
            If Cells(4, daynum) = "" Then
                Cells(300, daynum - 1).End(xlUp).Copy Destination:=Cells(4, daynum)
            End If
            
        Next daynum
    Next weeknum
End Sub

Open in new window

Commented:
While you didn't explicitly ask for it, this version adds two improvements:
1) it doesn't show the macro working (turns off screen updating)
2) also handles the first day of every week - in other words, if the first cell on week 4 is blank, it will copy the last value from the last day in week 3

Sub Macro1()
    Dim weeknum As Integer
    Dim daynum As Integer
    
    ' Hide the macro doing its work
    Application.ScreenUpdating = False
    
    ' Loop through each "Week" sheet
    For weeknum = 1 To 5
        Sheets("Week" & weeknum).Activate
        
        ' Loop through each day of the week
        For daynum = 2 To 8
        
            ' if we're in week 2 or later, also copy cells from the previous week
            If weeknum > 1 And daynum = 2 Then
            
                ' Check if the first row is blank
                ' if so, copy the value from the previous day (on the previous week)
                If Cells(4, daynum) = "" Then
                    Sheets("Week" & weeknum - 1).Cells(300, 8).End(xlUp).Copy Destination:=Cells(4, daynum)
                End If
            Else
            
                ' Check if the first row is blank
                ' if so, copy the value from the previous day
                If Cells(4, daynum) = "" Then
                    Cells(300, daynum - 1).End(xlUp).Copy Destination:=Cells(4, daynum)
                End If
            End If
            
        Next daynum
    Next weeknum
    
    'Re-enable screen updating
    Application.ScreenUpdating = True
End Sub

Open in new window

Author

Commented:
Hi m4trix,

Thanks a lot for the code. Is that possible to add one more function? Do not copy if the "date" cell (B2:H2) is blank.  Hope you will consider.
Commented:
Not a problem:
Sub Macro1()
    Dim weeknum As Integer
    Dim daynum As Integer
    
    ' Hide the macro doing its work
    Application.ScreenUpdating = False
    
    ' Loop through each "Week" sheet
    For weeknum = 1 To 5
        Sheets("Week" & weeknum).Activate
        
        ' Loop through each day of the week
        For daynum = 2 To 8
        
            ' Check if there is a date in row 3 (skip if not)
            If Cells(3, daynum) <> "" Then
            
                ' if we're in week 2 or later, also copy cells from the previous week
                If weeknum > 1 And daynum = 2 Then
                
                    ' Check if the first row is blank
                    ' if so, copy the value from the previous day (on the previous week)
                    If Cells(4, daynum) = "" Then
                        Sheets("Week" & weeknum - 1).Cells(300, 8).End(xlUp).Copy Destination:=Cells(4, daynum)
                    End If
                Else
                
                    ' Check if the first row is blank
                    ' if so, copy the value from the previous day
                    If Cells(4, daynum) = "" Then
                        Cells(300, daynum - 1).End(xlUp).Copy Destination:=Cells(4, daynum)
                    End If
                End If
                
            End If
            
        Next daynum
    Next weeknum
    
    'Re-enable screen updating
    Application.ScreenUpdating = True
End Sub

Open in new window

Author

Commented:
Hi m4trix,

Thanks a lot for the great solution.

Explore More ContentExplore courses, solutions, and other research materials related to this topic.