Repeat filling QTY into the empty cells of adjacent cells based on the previous column

tubrak

Board Regular
Joined
May 30, 2021
Messages
216
Office Version
  1. 2019
Platform
  1. Windows
Hi,

every day I add new column contains DATE(TODAY) and will add some values in cells and some cells will be empty .

what I want filling the same QTY in the empty cell under date (today) header based on adjecnt cells for precede column .

here is data
TT.xlsm
ABCDEFGH
1S.NITEMQTY13/01/202414/01/202415/01/202416/01/202417/01/2024
21CTR 12-200M45 MM 123H K/L12.0022.00
32CCTR 12-200M45 MM 123H K/L13.00
43TR 200M45MM LK H K/L14.00
54TR 200M451 NMM LK H K/L15.00
65TTR 12200S45 MN 12316.00
76TR 1425/148V MN 123H K/L17.00
87TR 200M45 MM 123H K/L SS18.0012.00
98TR 2.5M100* 123H K/L19.00
109TR 2.5M100**123H K/L20.00
1110TRMN 22.5M100* 123H K/L21.00
1211TTRM 12200S45 MN 123422.00
1312TTRR 1200S45 MN 12323.00
1413TR 1200M45MM LK H K/L24.00
1514BTR-100***8 RRT-DE3423025.0011.00
1615BTR-100***8 RRT-DE3423126.00
1716BTR-100***8 RRT-DE3423227.00
1817BTR-100***8 RRT-DE3423328.00
1918BTR-100***8 RRT-DE3423429.00
2019TR 2.5M100**123H K/LM30.00
ITEMS


result


TT.xlsm
ABCDEFGH
1S.NITEMQTY13/01/202414/01/202415/01/202416/01/202417/01/2024
21CTR 12-200M45 MM 123H K/L12.0022.00
32CCTR 12-200M45 MM 123H K/L13.0013.00
43TR 200M45MM LK H K/L14.0014.00
54TR 200M451 NMM LK H K/L15.0015.00
65TTR 12200S45 MN 12316.0016.00
76TR 1425/148V MN 123H K/L17.0017.00
87TR 200M45 MM 123H K/L SS18.0012.00
98TR 2.5M100* 123H K/L19.0019.00
109TR 2.5M100**123H K/L20.0020.00
1110TRMN 22.5M100* 123H K/L21.0021.00
1211TTRM 12200S45 MN 123422.0022.00
1312TTRR 1200S45 MN 12323.0023.00
1413TR 1200M45MM LK H K/L24.0024.00
1514BTR-100***8 RRT-DE3423025.0011.00
1615BTR-100***8 RRT-DE3423126.0026.00
1716BTR-100***8 RRT-DE3423227.0027.00
1817BTR-100***8 RRT-DE3423328.0028.00
1918BTR-100***8 RRT-DE3423429.0029.00
2019TR 2.5M100**123H K/LM30.0030.00
ITEMS



another example
TT.xlsm
ABCDEFGH
1S.NITEMQTY13/01/202414/01/202415/01/202416/01/202417/01/2024
21CTR 12-200M45 MM 123H K/L12.0022.00
32CCTR 12-200M45 MM 123H K/L13.0013.00
43TR 200M45MM LK H K/L14.0014.00122.00
54TR 200M451 NMM LK H K/L15.0015.00
65TTR 12200S45 MN 12316.0016.00
76TR 1425/148V MN 123H K/L17.0017.0012.00
87TR 200M45 MM 123H K/L SS18.0012.00
98TR 2.5M100* 123H K/L19.0019.00
109TR 2.5M100**123H K/L20.0020.0034.00
1110TRMN 22.5M100* 123H K/L21.0021.00
1211TTRM 12200S45 MN 123422.0022.00
1312TTRR 1200S45 MN 12323.0023.00
1413TR 1200M45MM LK H K/L24.0024.0034.00
1514BTR-100***8 RRT-DE3423025.0011.00
1615BTR-100***8 RRT-DE3423126.0026.00
1716BTR-100***8 RRT-DE3423227.0027.0045.00
1817BTR-100***8 RRT-DE3423328.0028.00
1918BTR-100***8 RRT-DE3423429.0029.00
2019TR 2.5M100**123H K/LM30.0030.00
ITEMS



result

TT.xlsm
ABCDEFGH
1S.NITEMQTY13/01/202414/01/202415/01/202416/01/202417/01/2024
21CTR 12-200M45 MM 123H K/L12.0022.0022.00
32CCTR 12-200M45 MM 123H K/L13.0013.0013.00
43TR 200M45MM LK H K/L14.0014.00122.00
54TR 200M451 NMM LK H K/L15.0015.0015.00
65TTR 12200S45 MN 12316.0016.0016.00
76TR 1425/148V MN 123H K/L17.0017.0012.00
87TR 200M45 MM 123H K/L SS18.0012.0012.00
98TR 2.5M100* 123H K/L19.0019.0019.00
109TR 2.5M100**123H K/L20.0020.0034.00
1110TRMN 22.5M100* 123H K/L21.0021.0021.00
1211TTRM 12200S45 MN 123422.0022.0022.00
1312TTRR 1200S45 MN 12323.0023.0023.00
1413TR 1200M45MM LK H K/L24.0024.0034.00
1514BTR-100***8 RRT-DE3423025.0011.0011.00
1615BTR-100***8 RRT-DE3423126.0026.0026.00
1716BTR-100***8 RRT-DE3423227.0027.0045.00
1817BTR-100***8 RRT-DE3423328.0028.0028.00
1918BTR-100***8 RRT-DE3423429.0029.0029.00
2019TR 2.5M100**123H K/LM30.0030.0030.00
ITEMS

I want macro for 5000 rows if it's possible
thank you
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Try this:

VBA Code:
Sub filling_qty()
  Dim j As Long, lr As Long
  Application.ScreenUpdating = False
  
  lr = Range("B" & Rows.Count).End(3).Row
  For j = 4 To Cells(1, Columns.Count).End(1).Column
    If Cells(1, j).Value = Date Then
      With Range(Cells(2, j), Cells(lr, j))
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
        .Copy
        .PasteSpecial Paste:=xlPasteValues
      End With
      Exit For
    End If
  Next

  Application.ScreenUpdating = True
  Application.CutCopyMode = False
End Sub
 
Upvote 0
Hi Dante again !
the code is really efficient .(y)
how can I fix the error in this line
VBA Code:
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
if there is no empty cell ,please?
 
Upvote 0
if there is no empty cell ,please?
Try:

Rich (BB code):
Sub filling_qty()
  Dim j As Long, lr As Long
  Application.ScreenUpdating = False
  
  lr = Range("B" & Rows.Count).End(3).Row
  For j = 4 To Cells(1, Columns.Count).End(1).Column
    If Cells(1, j).Value = Date Then
      With Range(Cells(2, j), Cells(lr, j))
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
        .Copy
        .PasteSpecial Paste:=xlPasteValues
      End With
      Exit For
    End If
  Next

  Application.ScreenUpdating = True
  Application.CutCopyMode = False
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,215,096
Messages
6,123,074
Members
449,093
Latest member
ripvw

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top