Moving a row of data automatically based on a specific criteria from sheet1 to sheet2, macro, vba or vlookup?

[skreechy]

HI,


I hope I'm doing this correctly, as it's my 1st post.


Great info here, I'm relatively new to Excel, but i know it does what I want, it's just getting to that point

I'm trying to move a row (horizontal) from sheet1 to sheet2 automatically based on there being content in column b (vertical),
what i'm trying to do is create a 2nd sheet (invoice in this exercise) where the whole row of is moved onto sheet2 based on there being a value in colume B
I hope this explains the excercise in hand?

I've attached a sample worksheet so you can see the example a bit clearer,

The idea is to create a sheet that automatically populates with the data from sheet1 to sheet2 to eliminate the copy and pasting of data every time a report is filled as only the the data that has a value in it from sheet1 column B is required as its a completed task.
(I hope I'm making sense)

So far I've used this,


Private Sub Worksheet_Change(ByVal Target As Range)


If Intersect(Target, Columns("B:B")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub

Application.EnableEvents = False
Application.ScreenUpdating = False


Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row


For Each cell In Range("B7:B" & lRow)
If cell.Value > 0 Then
Range(Cells(cell.Row, "A"), Cells(cell.Row, "P")).Copy
Sheets("Sheet2").Range("B100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
Next

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Data transfer completed!", vbExclamation


End Sub


but it doesn't work well as if a value is put in column B, then removed, the data stays on sheet2,
(I've removed the data transferred box as well, as it pops up every time a value is placed in column B)
Any help would be greatly appreciated,

I've tried searching but the results require tweaking, which my limited knowledge doesn't allow for.

Sample

https://www.dropbox.com/s/nimoic63gaqlusz/TEST TEMPLATE C-W INVOICE.xlsx?dl=0

Thanks in advance


Skreechy

 

[bugmonsta]

Hi,

I am new to VBA and with some searching I have been working on something for part of a project and thought it might help you out/get you on the right path.

My Macro checks if column B (row 2 down to allow for titles) contains something, if it does then it moves this to a new sheet called "Done" and deletes the original. It will also display a count of rows moved:

Sub StockDone()

Application.ScreenUpdating = False

    UsdRws = Range("B" & Rows.Count).End(xlUp).Row
    
    For i = UsdRws To 2 Step -1
        If Range("B" & i).Value <> "" Then
               Rows(i).Copy Sheets("Done").Range("A" & Rows.Count).End(xlUp).Offset(1)
               rr = rr + 1
            Rows(i).Delete
        End If
    Next i
    If rr >= 1 Then
      
MsgBox "Total Rows Moved: " & rr, vbInformation, "Records Removed"
 Else
Application.ScreenUpdating = True
End If

End Sub

Now I also have this macro (same as above with some minor tweaks) which will check if the Done tab has anything in column B. If it is EMPTY it will move it back to the master sheet called "Stock1".

As a quick fix until its in a user form or menu (depending on what the end user wants) I have used the active worksheet name to select the Done tab, process and then select stock1 again... ugly but works for my testing.
Obviously change your sheet names to match yours if its of any help.

Sub MoveDoneSheettoSheet1()
ActiveWorkbook.Worksheets("Done").Select

    Dim UsdRws As Long
    Dim i As Long
   
Application.ScreenUpdating = False

    UsdRws = Range("B" & Rows.Count).End(xlUp).Row
    
    For i = UsdRws To 2 Step -1
        If Range("B" & i).Value <> "" Then
               Rows(i).Copy Sheets("Stock1").Range("A" & Rows.Count).End(xlUp).Offset(1)
               rr = rr + 1
            Rows(i).Delete
        End If
    Next i
    If rr >= 1 Then
      
MsgBox "Total Rows Moved: " & rr, vbInformation, "Records Removed"
 Else
Application.ScreenUpdating = True
End If

ActiveWorkbook.Worksheets("Stock1").Select
End Sub

So the first macro will move ID1 and 3. It will ignore the title row and ID2:


[table="width: 500, class: grid"]
[tr]
[td]Title a[/td]
[td]Title b[/td]
[td]Title c[/td]
[td]Title d[/td]
[td]Title e[/td]

[/tr]
[tr]
[td]id1[/td]
[td]DONE[/td]
[td]stock detail[/td]
[td]stock number[/td]
[td]stock something[/td]

[/tr]
[tr]
[td]id2[/td]
[td][/td]
[td]stock detail[/td]
[td]stock number[/td]
[td]stock something[/td]
[/tr]
[tr]
[td]id3[/td]
[td]DONE[/td]
[td]stock detail[/td]
[td]stock number[/td]
[td]stock something[/td]

[/tr]
[/table]

 

[bugmonsta]

Typo in my 2nd macro... and cannot edit the post

If Range("B" & i).Value <> "" Then

should read:

If Range("B" & i).Value [B][COLOR="#FF0000"]=[/COLOR][/B] "" Then

otherwise it moves everything back! doh! The above change checks if column B EQUALS nothing and then moves it back!

 

[skreechy]

Thank you, I'll give it a go and report back with my findings.