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