PDA

View Full Version : Conditionally copy content of adjacent cells to different worksheet



MrTinkertrai
01-22-2019, 05:09 AM
Hello Excelexperts,

In my worksheet called "WEEKPLANNING" I have a range currently stretching from cell AF23 to AF34.
Each cell within that range is either filled with "TRUE" or "FALSE"
Whenever it's TRUE I would like to have the contents of the adjacent cell (e.g. AG23, AG24 etc) copied to another worksheet (Sheet1) starting from B1 downwards.
Preferably I would like to make my current range dynamic.

Is there someone who can help me with that ?

Many thanks in advance,

Mike

Kenneth Hobs
01-22-2019, 07:50 AM
The two approaches would be by a macro or by a formula. Both methods have their trade-offs.

By dynamic, do you want each change to update the whole output or just to use the input from AF23 and down?

MrTinkertrai
01-22-2019, 07:58 AM
Hello Kenneth,

Thanks for chiming in.

By dynamic I meant that currently my range starts at AF23 and ends at AF34, but in the future that last cell could expand to AF50 or even further.

Kenneth Hobs
01-22-2019, 08:51 AM
Sub Main()
Dim r As Range, t As Range, a As Range

Set t = Worksheets("Sheet1").[A1]
With Worksheets("WEEKPLANNING")
Set r = .Range("AF24", .Cells(Rows.Count, "AF").End(xlUp))
End With

r.AutoFilter 1, "=True"
Set a = StripFirstRow(r).Columns(2).SpecialCells(xlCellTypeVisible)
r.AutoFilter

If a Is Nothing Then Exit Sub
a.Copy t
Application.CutCopyMode = False
End Sub


Function StripFirstRow(aRange As Range) As Range
Dim i As Long, j As Long, r As Range, z As Long, idx As Long
For i = 1 To aRange.Areas.Count
For j = 1 To aRange.Areas(i).Rows.Count
z = z + 1
If z = 1 Then GoTo NextJ
If r Is Nothing Then
Set r = aRange.Areas(i).Rows(j)
Else
Set r = Union(r, aRange.Areas(i).Rows(j))
End If
NextJ:
Next j
Next i
Set StripFirstRow = r
End Function

MrTinkertrai
01-22-2019, 09:35 AM
Thank you very much, Kenneth

It works beautifully !!

Much appreciated

MrTinkertrai
02-19-2019, 02:52 AM
Sub Main()
Dim r As Range, t As Range, a As Range

Set t = Worksheets("Sheet1").[A1]
With Worksheets("WEEKPLANNING")
Set r = .Range("AF24", .Cells(Rows.Count, "AF").End(xlUp))
End With

r.AutoFilter 1, "=True"
Set a = StripFirstRow(r).Columns(2).SpecialCells(xlCellTypeVisible)
r.AutoFilter

If a Is Nothing Then Exit Sub
a.Copy t
Application.CutCopyMode = False
End Sub


Function StripFirstRow(aRange As Range) As Range
Dim i As Long, j As Long, r As Range, z As Long, idx As Long
For i = 1 To aRange.Areas.Count
For j = 1 To aRange.Areas(i).Rows.Count
z = z + 1
If z = 1 Then GoTo NextJ
If r Is Nothing Then
Set r = aRange.Areas(i).Rows(j)
Else
Set r = Union(r, aRange.Areas(i).Rows(j))
End If
NextJ:
Next j
Next i
Set StripFirstRow = r
End Function




Like I mentioned before this piece of code from Kenneth works like a charm.
I had to make some changes to my file and the range I was talking about (AF23:AF34) are now filled with formulas instead of TRUE or FALSE.
I would like to have the contents of the adjacent cells copied and pasted as values.

I've been trying figuring out myself where to add some code or make some changes, but to no avail.
I hope Kenneth or someone else could chime in here.

Many thanks in advance,

Mike

Kenneth Hobs
02-19-2019, 07:17 AM
'a.Copy t
a.Offset(,1).Copy t.offset(,1)