Search code examples
excelcopy-pastevba

VBA Clear and Copy without blank rows to another sheet on entering value greater than


My 2010 macro updates on opening a sheet. Does 2016 work the same when when they have the target sheet opened in a new 'instance'? It has to be idiot proof (I don't know why they asked me to do it :P). So the macro has to run once when opening the sheet; if the sheet is opened on the second monitor run every time a value is inserted over 119 in the source sheet; Don't run unnecessary because of the potentially very large sheets and meh laptops.

I've made this macro so the sheets my colleges are using don't need 'complex' formulas or macros to clear blank rows before it's exported to Word. I've made it in 2010, but I can't test it on 2016 til next week.

The macro that on the target sheet (J03);

Private Sub worksheet_activate()

And on the source sheet (WTB);

 Private Sub Run_When_Value_Greather_Than_119_Is_Entered_In_Column_G()

Google is clogged with answers and results about blank rows, copying, blank rows, running on other activation ways and non blank rows. I probably don't know what to look for either.

The full code;

Private Sub worksheet_activate()
  Dim Max As Long, MaxD As Long       'Determine the amount of filled rows
  Dim wsWtB As Worksheet, wsJ03 As Worksheet
  Dim wb As Workbook
  Dim i As Integer, j As Integer      'i and j for the row numbers

  Application.ScreenUpdating = False  'screenupdating of for max speeds

  Set wb = ThisWorkbook
  Set wsJ03 = Sheets("J_03")
  Set wsWtB = Sheets("WTB")

  Max = WorksheetFunction.Max(wsWtB.Range("A3:A1600"))  'Amount of rows with data
  Max = Max + 3                                         'Ignore the headers
  MaxD = WorksheetFunction.Max(wsJ03.Range("A3:A1600"))
  MaxD = MaxD + 2
  j = 9                   'The rownumber where the copying needs to start
    wsJ03.Range("B9", Cells(MaxD, 5)).ClearContents  'Clear the old values
      For i = 3 To Max    'The copying loop has to start after the headers at row 3
        If wsWtB.Cells(i, 7).Value > 119 Then   'Do stuff if...
          wsJ03.Cells(j, "B").Value = Chr(39) & wsWtB.Cells(i, "B").Value 'At a  '
          wsJ03.Cells(j, "C").Value = Chr(39) & wsWtB.Cells(i, "C").Value 'at the start
          wsJ03.Cells(j, "D").Value = Chr(39) & wsWtB.Cells(i, "D").Value 'so a zero is
          wsJ03.Cells(j, "E").Value = Chr(39) & wsWtB.Cells(i, "E").Value 'displayed
          j = j + 1       'Set the next row for the target sheet
        Else
      End If
    Next i
  Application.ScreenUpdating = True
End Sub

It's the first piece of code that I got working without hiccups :-) Feel free to comment and ad the propper tags.

Koen.

Edit; (Alternative ways to look for the last cell)

?thisworkbook.sheets("WTB").cells(rows.Count,"A").end(xlup).row
  1047 '<- Rownumber of the last cell with a Formula to create/force 
        successive 
        numbers
?thisworkbook.sheets("WTB").columns("A").Find(What:="*", LookIn:=xlValues, 
 SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  5    '<- Rownumber of the last cell with a value. Includes the header 
        rows
?WorksheetFunction.Max(thisworkbook.sheets("WTB").Range("A3:A1600"))
  3    '<- Highest number in A3:A1600 and also the amount units/rows that 
        need to be copied to "J_03"

I needed a function that gave me the amount of 'things' on the sheet. In this case it's 3, but it could go up to 1600.

Edit 2; (google sheet so you can see what i'm working on) https://docs.google.com/spreadsheets/d/1I5qLeOS0DWcwncs_ium_J0Vp6b4nzTsiE0ndbKtpsC0/edit?usp=sharing

Edit 3; there was an error in the clear range part. wsJ03.Range("B9", Cells(MaxD, 5)).ClearContents 'Clear the old values


Solution

  • You could use something like the following, but make sure you place the code in the Sheet where the values might be changing (Sheets("WTB")):

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 7 Then 'If something changed in column G
            If Target.Value > 119 Then 'and if the value is higher than 119
            NextFreeRow = Sheets("J_03").Cells(.Rows.Count, "B").End(xlUp).Row + 1
            'Or Do your copying stuff, you can use Target.column or Target.row to find the address of the cell that got a value higher than 119
                Sheets("J_03").Cells(NextFreeRow, "B").Value = Chr(39) & Sheets("WTB").Cells(Target.Row, "B").Value 'At a  '
                Sheets("J_03").Cells(NextFreeRow, "C").Value = Chr(39) & Sheets("WTB").Cells(Target.Row, "C").Value 'at the start
                Sheets("J_03").Cells(NextFreeRow, "D").Value = Chr(39) & Sheets("WTB").Cells(Target.Row, "D").Value 'so a zero is
                Sheets("J_03").Cells(NextFreeRow, "E").Value = Chr(39) & Sheets("WTB").Cells(Target.Row, "E").Value 'displayed
            End If
        End If
    End Sub