PDA

View Full Version : Auto fill from multiple rows & cells



Manos123
02-27-2018, 06:39 AM
I have been trying to put together a macro to run several automated tasks that would normally take a long time if done manually. I am very close to completion but stuck on the final section. I have put the below together using guides etc online and to someone who understands it more than me it probably looks very messy & shows a lack of understanding. I guess everyone has to start somewhere!

So I am trying to do the following. Insert a blank row(s) based on the value in column B. So in row 1 if column B has a value of 3, then 3 blank rows would be inserted between row 1 & 2. Then the macro looks atthe next row containing data & follows the same process. This leaves me with rows of data with X amount of blank rows in between. Which is exactly whatI want.
What I am trying to do next & have been unsuccessful isto auto fill 2 of the columns in the newly inserted blank rows. I need to autofill column A with the word PC in the newly inserted blank rows only. Also need to Auto fill column K but this needs to be populated with whatever value is inthe cell above it. For example in Column K1 there’s a value of 3. K2-K4 areblank. K5 has a value of 8. K6-K10 are blank. In this example I would need K2-K4 to Fill from K1 & K6-K10 to fill from K5. So this would
This is what I have so far. As you can see it works as faras to fill to the next line of data & then stops. It also over writes thedata in Column A & K in the next row of data which I don’t want. I have also attached a test file to run the macro against

Sub Step1()

Dim rng As Range
Dim ws AsWorksheet: Set ws = Sheets("Test File 190218 - M - Copy")
lastRow =ws.Cells(ws.Rows.count, "A").End(xlUp).Row
ws.Columns("A:A").InsertShift:=xlToRight
Set rng =ws.Range("A1:A" & lastRow)
rng.Value ="OR"
Worksheets("Test File 190218 - M - Copy").Activate
Dim r, count AsRange
Dim temp AsInteger
Application.ScreenUpdating = False
Application.Calculation= xlCalculationManual
Set r =Range("B:D")
Set count =Range("C:C")
lastRow =Range("C" & Rows.count).End(xlUp).Row
For n = lastRow To1 Step -1
temp =Range("C" & n)
If (temp >1) Then
Rows(n + 1& ":" & n + temp).Insert Shift:=xlDown
End If
Next n
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Set rng =ws.Range(Range("A2"), Range("A" & lastRow))
rng.Value ="PC"
lastRow = Range("L2").End(xlDown).Row
Range("L1").AutoFillDestination:=Range(Range("L1"), Range("L" & lastRow))
End Sub

p45cal
02-27-2018, 02:45 PM
Small changes to existing code:
Sub Step1()
Dim r, count As Range
Dim temp As Long
Dim rng As Range
Dim ws As Worksheet

Set ws = Sheets("Test File 190218 - M - Copy")
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
ws.Columns("A:A").Insert Shift:=xlToRight
Set rng = ws.Range("A1:A" & lastRow)
rng.Value = "OR"
Worksheets("Test File 190218 - M - Copy").Activate
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set r = Range("B:D")
Set count = Range("C:C")
lastRow = Range("C" & Rows.count).End(xlUp).Row
For n = lastRow To 1 Step -1
temp = Range("C" & n)
If (temp > 1) Then
Rows(n + 1 & ":" & n + temp).Insert Shift:=xlDown
Rows(n + 1 & ":" & n + temp).Columns(1).Value = "PC"
Rows(n + 1 & ":" & n + temp).Columns(12).Value = Cells(n, 12).Value
End If
Next n
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Manos123
02-28-2018, 04:09 AM
Small changes to existing code:
Sub Step1()
Dim r, count As Range
Dim temp As Long
Dim rng As Range
Dim ws As Worksheet

Set ws = Sheets("Test File 190218 - M - Copy")
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
ws.Columns("A:A").Insert Shift:=xlToRight
Set rng = ws.Range("A1:A" & lastRow)
rng.Value = "OR"
Worksheets("Test File 190218 - M - Copy").Activate
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set r = Range("B:D")
Set count = Range("C:C")
lastRow = Range("C" & Rows.count).End(xlUp).Row
For n = lastRow To 1 Step -1
temp = Range("C" & n)
If (temp > 1) Then
Rows(n + 1 & ":" & n + temp).Insert Shift:=xlDown
Rows(n + 1 & ":" & n + temp).Columns(1).Value = "PC"
Rows(n + 1 & ":" & n + temp).Columns(12).Value = Cells(n, 12).Value
End If
Next n
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Hi,

Just wanted to say a massive thank you for your help with the above. It works exactly how I wanted it to. I really can't thank you enough. Wishing you all the best