Consulting

Results 1 to 3 of 3

Thread: Auto fill from multiple rows & cells

  1. #1
    VBAX Newbie
    Joined
    Feb 2018
    Posts
    2
    Location

    Auto fill from multiple rows & cells

    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
    Attached Files Attached Files
    Last edited by Manos123; 02-27-2018 at 06:48 AM. Reason: Forgot to attach file!

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    VBAX Newbie
    Joined
    Feb 2018
    Posts
    2
    Location

    Many Thanks

    Quote Originally Posted by p45cal View Post
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •