Home > database >  VBA help copy/paste in same sheet in next available row
VBA help copy/paste in same sheet in next available row

Time:06-20

I want to create a command button which copies a range of cells and pastes them into the next empty range.

I have found a code online which I tweaked to perform the function, but it does not work when I add conditional formatting.

The conditional formating being, blank cells = yellow.

The VBA im currently using is:

Private Sub CommandButton1_Click()
  Application.ScreenUpdating = False
  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet

  Set copySheet = Worksheets("Sheet1")
  Set pasteSheet = Worksheets("Sheet1")

  copySheet.Range("B11:J11").Copy
  pasteSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

If I enter a value into the blank cell the above VBA works fine, however if I leave the cell blank it does not paste into the next cell.

The aim was for the user to paste in as many rows as needed, and the yellow shading to indicate which cells to add a value in.

I hope this makes sense. I'm not particularly used to these functions in excel.

CodePudding user response:

Try this code:

Private Sub CommandButton1_Click()
    
    'Macro to copy in a new row.
    
    'Turning off screen updating.
    Application.ScreenUpdating = False
    
    'Declarations.
    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    Dim targetRange As Range
    
    'Setting variables.
    Set copySheet = Worksheets("Sheet1")
    Set pasteSheet = Worksheets("Sheet1")
    
    'Setting targetRange as the last cell in column B with value.
    Set targetRange = pasteSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
    
    'Setting targetRange as the first cell in column B with no conditional formatting under the last cell in column B with no value.
    Do Until targetRange.FormatConditions.Count = 0
        Set targetRange = targetRange.Offset(1, 0)
    Loop
    
    'Copying range B11:J11.
    copySheet.Range("B11:J11").Copy
    
    'Pasting the copied range in targetRange.
    targetRange.PasteSpecial xlPasteAll
    
    'Turning off the cut-copy mode.
    Application.CutCopyMode = False
    
    'Turning on the screen updating.
    Application.ScreenUpdating = True
    
End Sub

I've taken your code and added the variable targetRange. Said variable is then set as the last cell with value in column B (similar to what you have already done) and then i use a Do Loop cycle to set targetRange as the first cell with no conditional formatting under the last cell with value in column B. I've also added the proper comments to the whole code.


Extra code as requested in comments.

You can obtain a sum of the values of a range while counting any "outgoing" value as a 7 with this formula:

=SUM(B11:B15,COUNTIF(B11:B15,"ongoing")*7)

You can use the same formula in a macro like this:

Sub Macro1()
    
    'A example of macro to return a range sum with any "ongoing" switched with 7.
    
    'Declaration.
    Dim rng As Range
    
    'Setting the seed range.
    Set rng = Range("B11")
    
    'Expanding rng to the last cell with value of its column.
    Set rng = Range(rng, Cells(Rows.Count, rng.Column).End(xlUp))
    
    'Reporting in the immediate window the result.Debug.Print Excel.WorksheetFunction.Sum(rng, Excel.WorksheetFunction.CountIf(rng, "ongoing") * 7)
    Debug.Print Excel.WorksheetFunction.Sum(rng, Excel.WorksheetFunction.CountIf(rng, "ongoing") * 7)
    
    'Reporting in the immediate window the result, this time using a With End With statement to make it more readable.
    With Excel.WorksheetFunction
        Debug.Print .Sum(rng, .CountIf(rng, "ongoing") * 7)
    End With
    
End Sub
  • Related