Help with Excel/VBA

[DavidAndrew]

Hi all,

Looking for some help with writing of VBA code for an excel sheets I am working on.

I have multiple worksheets on each of which have a "Current Status" column which I have a filter applied too, it has a few different options, complete, not started, in progress etc. Dependant on the status of this filter - I would like the row of this cell to be moved too a separate worksheet - called Status. I do not want the row to be removed - but copied across. I want this to work when I continue to update the sheet in the future also.

Additionally I would like to be able to only select certain columns from the row to appear on the "Status" worksheet - i.e not all the columns be moved across.

I am a total VBA novice and any advice would be greatly appreciated!

Many thanks,
David

 

[Yongle]

This code is now testing sheet CODENAMES to see if sheet qualifies for inclusion

Replace function IncludeSheet (provided in post#17) with the function below
Add the other relevant sheet codenames after "Sheet5"

Private Function IncludeSheet(ByVal sh As Object) As Boolean
    IncludeSheet = False
    Select Case sh.CodeName
        Case "Sheet1", "Sheet4", "Sheet5"   'list all sheets to be INCLUDED in quotation marks and separated by a comma
            IncludeSheet = True
    End Select
End Function

 

[DavidAndrew]

Hi Yongle,

Thanks again for replying.

I have amended the code from post 17 - to include the code sent in post 21. I have added all the sheets to the code that qualify for inclusion.

When I run the code the following only happens:

Only lines with the "Current Status" "Ordered" copy across - the correct columns for these copied rows also work (e.g A-C,G and AS-CO), However the other "Current Status" cell values do not copy across:

Unfortunately again I have had to update the Current Status column values to accommodate my work. Many apologies for changing this. I am trying to be as transparent as possible.

However the other "Current Status" cell values do not copy across.

Additionally when I run the code - the headers are now removed from the top row:

Below are 3 images. The first is one of the sheets that qualify for inclusion.

2nd image is the "Status" tab to help better explain what is going on.

3rd image is the your script with the ammendments I have made.

Many thanks for your patience and continued help!

 

[Yongle]

From now on we'll deal with every query separately until resolved

"when I run the code - the headers are now removed from the top row: "
are you saying that row 1 in sheet status is being overwritten? deleted?

Code
The code as a picture is of no use to me - you will appreciate that I do not want to have to search for your amendments and then amend my code!
If I need to test it I need the code itself
click on <vba\> and post the code you are using (ie in the picture) pasted between the code tags

 

[DavidAndrew]

That makes sense to do.

Apologies for my poor terminology. Yes Row 1 has now been removed/deleted and replaced with the rows being copied across.

Many thanks,

David

 

[Yongle]

don't foget to post the code

 

[DavidAndrew]

Apologies Yongle,

Please see code below.

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Set Target = Cells(Target.Row, "A")
If Target.Row = 1 Then Exit Sub
If Not StatusListed(Range("G" & Target.Row)) Then Exit Sub
If IncludeSheet(sh) Then Call CopyRow(Target, Sheets("Status"))
End Sub
Private Function IncludeSheet(ByVal sh As Object) As Boolean
IncludeSheet = False
Select Case sh.CodeName
Case "Sheet2", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10", "Sheet11", "Sheet12", "Sheet13", "Sheet14", "Sheet15", "Sheet16", "Sheet17", "Sheet18", "Sheet19", "Sheet20", "Sheet21", "Sheet22", "Sheet23", "Sheet24", "Sheet25", "Sheet31", "Sheet32"
IncludeSheet = True
End Select
End Function
Private Function StatusListed(ByVal CurrentStatus As String) As Boolean
Select Case LCase(CurrentStatus)
Case "Complete - Invoice Paid", "Not being progressed", "all received", "ordered", "Research"
StatusListed = True
End Select
End Function
Private Sub CopyRow(Target As Range, ws As Worksheet)
Dim sRow As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
With ws
sRow = .Cells(Rows.Count, "D").End(xlUp).Row + 1 'next row in sheet Status
Target.Resize(, 3).Copy .Cells(sRow, "A") 'copy A:C
Target.Offset(, 6).Copy .Cells(sRow, "D") 'copy G
Target.Offset(, 44).Resize(, 49).Copy .Cells(sRow, "E") 'copy AS:CO
End With
Application.EnableEvents = True
End Sub

 

[Yongle]

As you can see above, you posted code has lost its VBA formatting
- the formatting is helpful
Plesae read instruction in previous post and try again

 

[DavidAndrew]

I think this is right now Yongle?

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Set Target = Cells(Target.Row, "A")
If Target.Row = 1 Then Exit Sub
If Not StatusListed(Range("G" & Target.Row)) Then Exit Sub
If IncludeSheet(sh) Then Call CopyRow(Target, Sheets("Status"))
End Sub
Private Function IncludeSheet(ByVal sh As Object) As Boolean
IncludeSheet = False
Select Case sh.CodeName
Case "Sheet2", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10", "Sheet11", "Sheet12", "Sheet13", "Sheet14", "Sheet15", "Sheet16", "Sheet17", "Sheet18", "Sheet19", "Sheet20", "Sheet21", "Sheet22", "Sheet23", "Sheet24", "Sheet25", "Sheet31", "Sheet32"
IncludeSheet = True
End Select
End Function
Private Function StatusListed(ByVal CurrentStatus As String) As Boolean
Select Case LCase(CurrentStatus)
Case "Complete - Invoice Paid", "Not being progressed", "all received", "ordered", "Research"
StatusListed = True
End Select
End Function
Private Sub CopyRow(Target As Range, ws As Worksheet)
Dim sRow As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
With ws
sRow = .Cells(Rows.Count, "D").End(xlUp).Row + 1 'next row in sheet Status
Target.Resize(, 3).Copy .Cells(sRow, "A") 'copy A:C
Target.Offset(, 6).Copy .Cells(sRow, "D") 'copy G
Target.Offset(, 44).Resize(, 49).Copy .Cells(sRow, "E") 'copy AS:CO
End With
Application.EnableEvents = True
End Sub

 

[DavidAndrew]

Yes I see it now that it I have posted the reply - all a learning curve! ?

 

[Yongle]

Better ... ..... but you should have copied from the original VBA once again
Don't bother doing it again .... but if you look at the picture of the code (post#22) you can see that the actual code is indented on various lines
The indentation is often very helpful