VBA to Paste Copied Row On Blank Cells In Range

[icedragone]

I am trying to create or find a VBA code that will allow me to copy row 1 on the sheet and paste the entire row in each blank cell in range A3:A177. I have data in random places throughout, so I can't put just every so many rows or cells. I need to run this macro after pasting the information on another sheet in the workbook and then having the blank rows created in that sheet. Then the sheet I am on that needs the information pasted to pulls that data from that first sheet. I have attached pictures that hopefully help you understand what I'm trying to accomplish. I would also like to have the Route # pasted into the blank Yellow cell on each of these blank rows after it is pasted, keeping the yellow highlighting, if that is possible. Then either deleting or turning the duplicate route #s white so they are not visible and it is just the one route # in yellow visible and all the account numbers and store names for that route under it. Pretty much, I need the sheet to look like the picture titled Goal, but automated.

 

[richh]

OK so trying to follow along the sequence you intend to get in line.

1. You enter in info on Original Sheet (OS)
2. You click the Insert Blank Rows button on OS
3. The Insert Blank command inserts a blank row between rows that do not share the same Route #
4. You are manually copying an entire row from OS
5. You are pasting said row into Target Sheet (TS)
6. You want TS to the reflect OS, but be color coded and formatted

First thing - If you intend to have TS only be used as a visual datasheet, blank rows are fine. However, if you intend to do any filtering in the future, I'd advise against blanks. I'm not sure how to go about following the need to copy/paste a row to kick off the update - I'd think that you'd just want to update TS whenever you click Add Blank Rows or have another command button to refresh TS after updating OS.

The code below is a function that avoids having to add blank cells in the original sheet. It's a heck of a lot easier to deal with data when there aren't breaks between records. Check out the different forms a database can be in, (1NF, 2NF, 3NF, etc.). This way, you can edit the data all you want on the original sheet and then run the update.

Public Sub UpdateTargetSheet()
    Dim targetWS    As Worksheet
    Dim sourceWS    As Worksheet
    Dim targetLRow  As Long
    Dim sourceLRow  As Long
    Dim routeNum    As Integer
    
    Set targetWS = Application.ThisWorkbook.Worksheets("Target")
    Set sourceWS = Application.ThisWorkbook.Worksheets("Source")
    
    targetLRow = targetWS.Cells(Rows.Count, 1).End(xlUp).Row
    sourceLRow = sourceWS.Cells(Rows.Count, 3).End(xlUp).Row
    
    If targetLRow > 1 Then targetWS.Range("A2:H" & targetLRow).Clear
    
    targetLRow = 2 'reset target row to first row after clearing range
    
    
    For i = 2 To sourceLRow
        routeNum = sourceWS.Cells(i, 1) 'Grab current route
        
        If IsEmpty(routeNum) = False Then
            If sourceWS.Cells(i - 1, 1) <> routeNum Then
            'If previous row has diff route num, add the dividing header
                targetWS.Cells(targetLRow, 1) = sourceWS.Cells(i, 1)
                targetWS.Range("A" & targetLRow & ":B" & targetLRow).Interior.ColorIndex = 6 ' Yellow
                targetWS.Cells(targetLRow, 2) = "WarehouseDelays"
                targetWS.Range("C" & targetLRow & ":H" & targetLRow).Interior.ColorIndex = 1 'Black
                
                targetWS.Cells(targetLRow + 1, 3) = sourceWS.Cells(i, 2)
                targetWS.Cells(targetLRow + 1, 4) = sourceWS.Cells(i, 3)
                targetWS.Cells(targetLRow + 1, 6) = CStr(VBA.Left(sourceWS.Cells(i, 4).Text, 5)) & _
                    " - " & VBA.Left(sourceWS.Cells(i, 5).Text, 5)
                
                targetLRow = targetLRow + 2
            Else 'If previous shares the same route number, populate the row with data
                targetWS.Cells(targetLRow, 3) = sourceWS.Cells(i, 2)
                targetWS.Cells(targetLRow, 4) = sourceWS.Cells(i, 3)
                targetWS.Cells(targetLRow, 6) = VBA.Left(sourceWS.Cells(i, 4).Text, 5) & _
                    " - " & VBA.Left(sourceWS.Cells(i, 5).Text, 5)
                
                targetLRow = targetLRow + 1
            End If
            
            
        Else
            ' Since the code above inserts separating rows
            ' based upon route num, no need to insert blanks on original sheet
        End If
    Next i
    
End Sub

 

[icedragone]

Basically, each day that we are late delivering a route, we have to update our Customer Care team. Since we have so many routes, I am trying to avoid having to type it all up or copy/paste each one individually. I need the black and yellow row to be the break between each route # and the stores associated with that route. The customer care team requires it to look exactly the way it does in the Goal picture. I copy and paste the information in the original sheet, then on the target sheet it pulls the data from the original sheet and calculates the new delivery windows based on however many hours late we will be. I mostly just want that black and yellow row to be the break between route numbers. I can deal with the rest of it, I just need that in there. I can't just have it inserted at every so many rows since the number of customers on each route changes. Sorry, I'm not sure how to explain it.

Also, I need to keep the second row that has the header information for what is listed in each column.

The code you provided mostly does the job, except the formula I have in Column G is deleted that populates the new delivery window and the Header row is deleted. I am providing an image of what happened when I used it.

I have a different sheet for however many hours delayed we are, so we can copy and paste depending on that rather than manually calculating the times.

This is the formula used in column F to get the original delivery window: =CONCATENATE(TEXT('Paste Here'!D2,"hh:mm")&" - "&TEXT('Paste Here'!E2,"hh:mm"))
This is the formula used in column G to get the revised delivery window: =CONCATENATE(TEXT(L3,"hh:mm")&" - "&TEXT(M3,"hh:mm"))
This is the formula used in columns L & M (which will be hidden) to add the time needed to the delivery window based on which tab it is:
Column L =IFERROR(('Paste Here'!D2+2/24)," ") The 2/24 is for 2-4 hours delayed. Otherwise it is 3/24 for the 3-5 hours delayed sheet, 4/24 for 4-6 hours delayed, etc.
Column M =IFERROR(('Paste Here'!E2+2/24)," ")


I'm really sorry if I made this more complicated than it needs to be...

 

[icedragone]

Basically, each day that we are late delivering a route, we have to update our Customer Care team. Since we have so many routes, I am trying to avoid having to type it all up or copy/paste each one individually. I need the black and yellow row to be the break between each route # and the stores associated with that route. The customer care team requires it to look exactly the way it does in the Goal picture. I copy and paste the information in the original sheet, then on the target sheet it pulls the data from the original sheet and calculates the new delivery windows based on however many hours late we will be. I mostly just want that black and yellow row to be the break between route numbers. I can deal with the rest of it, I just need that in there. I can't just have it inserted at every so many rows since the number of customers on each route changes. Sorry, I'm not sure how to explain it.

Also, I need to keep the second row that has the header information for what is listed in each column.

The code you provided mostly does the job, except the formula I have in Column G is deleted that populates the new delivery window and the Header row is deleted. I am providing an image of what happened when I used it.

I have a different sheet for however many hours delayed we are, so we can copy and paste depending on that rather than manually calculating the times.

This is the formula used in column F to get the original delivery window: =CONCATENATE(TEXT('Paste Here'!D2,"hh:mm")&" - "&TEXT('Paste Here'!E2,"hh:mm"))
This is the formula used in column G to get the revised delivery window: =CONCATENATE(TEXT(L3,"hh:mm")&" - "&TEXT(M3,"hh:mm"))
This is the formula used in columns L & M (which will be hidden) to add the time needed to the delivery window based on which tab it is:
Column L =IFERROR(('Paste Here'!D2+2/24)," ") The 2/24 is for 2-4 hours delayed. Otherwise it is 3/24 for the 3-5 hours delayed sheet, 4/24 for 4-6 hours delayed, etc.
Column M =IFERROR(('Paste Here'!E2+2/24)," ")


I'm really sorry if I made this more complicated than it needs to be...

Also, I want to mention that the route #s, store information, how many stores on each route #, delivery windows, etc. all changes each day and each week. It is almost never the same.

 

[richh]

I think a bit of alteration to my code will accomplish what you're seeking. If you type in the data in the OS, the function will take your entries and format them as you want. Check out the gif of how my code works:

https://imgur.com/whHIaCb

Public Sub UpdateTargetSheet()
    Dim targetWS    As Worksheet
    Dim sourceWS    As Worksheet
    Dim targetLRow  As Long
    Dim sourceLRow  As Long
    Dim routeNum    As Integer
    Dim formulaStr  As String
    
    Set targetWS = Application.ThisWorkbook.Worksheets("Target")
    Set sourceWS = Application.ThisWorkbook.Worksheets("Source")
    
    targetLRow = targetWS.Cells(Rows.Count, 3).End(xlUp).Row
    sourceLRow = sourceWS.Cells(Rows.Count, 3).End(xlUp).Row
    
    If targetLRow > 1 Then targetWS.Range("A2:H" & targetLRow).Clear
    If targetLRow > 1 Then targetWS.Range("L2:M" & targetLRow).Value = ""
    
    targetLRow = 2 'reset target row to first row after clearing range
    
    
    For i = 2 To sourceLRow
        routeNum = sourceWS.Cells(i, 1) 'Grab current route
        
        If IsEmpty(routeNum) = False Then
            If sourceWS.Cells(i - 1, 1) <> routeNum Then
            'If previous row has diff route num, add the dividing header
                targetWS.Cells(targetLRow, 1) = sourceWS.Cells(i, 1)
                targetWS.Range("A" & targetLRow & ":B" & targetLRow).Interior.ColorIndex = 6 ' Yellow
                targetWS.Cells(targetLRow, 2) = "WarehouseDelays"
                targetWS.Range("C" & targetLRow & ":H" & targetLRow).Interior.ColorIndex = 1 'Black
                
                targetWS.Cells(targetLRow + 1, 3) = sourceWS.Cells(i, 2)
                targetWS.Cells(targetLRow + 1, 4) = sourceWS.Cells(i, 3)
                targetWS.Cells(targetLRow + 1, 6) = CStr(VBA.Left(sourceWS.Cells(i, 4).Text, 5)) & _
                    " - " & VBA.Left(sourceWS.Cells(i, 5).Text, 5)
                
                formulaStr = "=IFERROR(Source!D" & i & " + 2/24, " & Chr(34) & " " & Chr(34) & ")"
                targetWS.Cells(targetLRow + 1, 12) = formulaStr
                
                formulaStr = "=IFERROR(Source!E" & i & " + 2/24, " & Chr(34) & " " & Chr(34) & ")"
                targetWS.Cells(targetLRow + 1, 13) = formulaStr
                
                targetWS.Cells(targetLRow + 1, 7) = VBA.Left(targetWS.Cells(targetLRow + 1, 12).Text, 5) & _
                    " - " & VBA.Left(targetWS.Cells(targetLRow + 1, 13).Text, 5)
                
                targetLRow = targetLRow + 2
            Else 'If previos is the same, enter in the data
                targetWS.Cells(targetLRow, 3) = sourceWS.Cells(i, 2)
                targetWS.Cells(targetLRow, 4) = sourceWS.Cells(i, 3)
                targetWS.Cells(targetLRow, 6) = VBA.Left(sourceWS.Cells(i, 4).Text, 5) & _
                    " - " & VBA.Left(sourceWS.Cells(i, 5).Text, 5)
                    
                formulaStr = "=IFERROR(Source!D" & i & " + 2/24, " & Chr(34) & " " & Chr(34) & ")"
                targetWS.Cells(targetLRow, 12) = formulaStr
                
                formulaStr = "=IFERROR(Source!E" & i & " + 2/24, " & Chr(34) & " " & Chr(34) & ")"
                targetWS.Cells(targetLRow, 13) = formulaStr
                
                targetWS.Cells(targetLRow, 7) = VBA.Left(targetWS.Cells(targetLRow, 12).Text, 5) & _
                    " - " & VBA.Left(targetWS.Cells(targetLRow, 13).Text, 5)
                
                targetLRow = targetLRow + 1
            End If
            
            
        Else
            ' Since the code above inserts separating rows
            ' based upon route num, no need to insert blanks on original sheet
        End If
    Next i
    
End Sub

Now, this code assumes that you are generating a single report after entering all delays in the source sheet. It will clear the information for the contact and notes. If you intend to keep a record of the reports generated, you could then create a copy of the target sheet, remove the formulas from the L-M columns, and then alter the Source sheet for the next report you need to generate.

Also, with this kind of tracking you're doing, it may be time to consider moving to a database. Access isn't too hard and the reports you can create come out with half as much effort as hard coding them in VBA. Just thinking about the data you contain makes it feel as though you should consider making entity tables. Almost every cell in your example feels like it is its own object. You have routes, accounts, store numbers and names. The contact may relate to any of the three entities.