PDA

View Full Version : If conditions are met, copy to new worksheet



Smucka
03-09-2020, 01:49 PM
Hi all,

I'm a bit of a newbie when it comes to VBA, so I'm hoping some good soul can help me out with my problem. I tried searching for a solution and found some things, but not exactly what I'm looking for.

I have a worksheet with some data (see screenshot). This data is updated weekly by adding or removing comments to damaged articles. What I'd like to do is, if there is a comment for a damaged article, I'd like excel to copy that whole row to another sheet. If that comment is deleted next week, the row wouldn't be copied. The screenshot provided is just an example, the real worksheet contains about 5k rows and 15 columns. I can provide more info if it's needed. Any help is greatly appreciated. Thanks!

Edit: what I mean by comment is the comment written in row, not the "red arrow" comment.

Logit
03-10-2020, 08:52 AM
.
Here is one method :


Option Explicit

Sub CpyRws()
Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
Set ws = Worksheets("Sheet2") 'specify sheet name here to paste to
x = 2 'begins pasting in Sheet 2 on row 2

Application.ScreenUpdating = False

With Worksheets("Sheet1")
Rws = .Cells(Rows.Count, "B").End(xlUp).Row 'searches Col B
Set Rng = .Range(.Cells(2, "B"), .Cells(Rws, "B"))
For Each c In Rng.Cells
If c.Value <> "" And c.Offset(0, 2).Value <> "" Then 'searches for non-blank cells
c.EntireRow.Copy
ws.Range("A" & x).PasteSpecial Paste:=xlValues
x = x + 1
End If
Next c
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
ws.Activate
ws.Range("A1").Select

End Sub

Smucka
03-10-2020, 02:52 PM
.
Here is one method :


Option Explicit

Sub CpyRws()
Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
Set ws = Worksheets("Sheet2") 'specify sheet name here to paste to
x = 2 'begins pasting in Sheet 2 on row 2

Application.ScreenUpdating = False

With Worksheets("Sheet1")
Rws = .Cells(Rows.Count, "B").End(xlUp).Row 'searches Col B
Set Rng = .Range(.Cells(2, "B"), .Cells(Rws, "B"))
For Each c In Rng.Cells
If c.Value <> "" And c.Offset(0, 2).Value <> "" Then 'searches for non-blank cells
c.EntireRow.Copy
ws.Range("A" & x).PasteSpecial Paste:=xlValues
x = x + 1
End If
Next c
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
ws.Activate
ws.Range("A1").Select

End Sub




Hi,

thanks for your quick reply. Just tried this and it works flawlessly. Thank you very much for helping me out, this will surely save me countless hours of combing data. Would this code also work if I wanted to insert a button so the code would run on click?

Logit
03-10-2020, 05:36 PM
.
Yup.

Paste the macro in a Regular Module.

Paste a CommandButton on the first sheet and attach it to the macro.

Smucka
03-11-2020, 07:12 AM
.
Yup.

Paste the macro in a Regular Module.

Paste a CommandButton on the first sheet and attach it to the macro.

Hello, I just tried doing this and succeeded on first try. Thank you! It works as intended. This is a life saver.

So I got a new table today, which is really similar to this one, but I already have sheet2 and articles (without comments) on it. The problem now is, that on this sheet2, all articles are jumbled. How would I go about searching sheet1 for article which has a comment and copy pasting that comment to same article in sheet2 (but the article is not on the same row as in sheet1). I'm providing another screenshot so you'll know what I mean. I suspect this complicates things a bit. Also, sorry for asking so many (not so great) questions.