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