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]

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

It does not make sense to me that this is happening, because the value in header D1 should prevent what you are saying from happening
But try inserting the red line

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
        If sRow = 1 Then sRow = 2
        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

Let me know if that fixes the issue

 

[DavidAndrew]

Evening Yongle,

I have inserted the red line in the position of the code as instructed.

I can confirm that there has been no change to the result.

A couple of things have came to my mind - It is row 3 on the required to be included tabs that needs to be copied as the "header" (not sure of better terminology here). See my post no.22 and the first image for some clarity.

Additionally I just wanted to check that I was running the macro correctly.

To test I am doing the following:

Inputting the code in ThisWorkbook and then pressing "Run"
The following box then appears and I create a Macro under a test name. See below image

Save the file
Going to one of the required Tabs to be included, selecting on the screen
Selecting the developer tab and then pressing macros
Choose the macro of the latest code update
Press Run
Return to Status tab to check for changes.

Does this appear to be the correct order of things?

Many thanks again for your time.

David

 

[Yongle]

The code runs automatically when values are amended in the relevant sheets
No other subs required

 

[DavidAndrew]

The code runs automatically when values are amended in the relevant sheets
No other subs required

So once the code is saved I do not need to do anything else?

Thanks for your reply.

David

 

[Yongle]

are we communicating badly ?

This is what the code does
When a value is entered or amended (in any of the sheets specified in Select Case)
.. the code automatically
... checks the value in column G in the same row
.... IF the value is "completed", "work in progress", "received" or "ordered"
..... THEN the code copies that row
........ the row is pasted in the next available row in sheet "Status"

Is that what you want or not ?
If it is not EXACTLY what you want, then tell me what you do want the code to do
I will not be on the thread again for about 24 hours

 

[DavidAndrew]

are we communicating badly ?

Hi Yongle.

The below is correct, other than the part "IF the value is" - I will need too add more values to this list. Speak to you when you are back on the thread.

Many thanks,

David


This is what the code does
When a value is entered or amended (in any of the sheets specified in Select Case)
.. the code automatically
... checks the value in column G in the same row
.... IF the value is "completed", "work in progress", "received" or "ordered"
..... THEN the code copies that row
........ the row is pasted in the next available row in sheet "Status"

Is that what you want or not ?
If it is not EXACTLY what you want, then tell me what you do want the code to do
I will not be on the thread again for about 24 hours

 

[Yongle]

"The below is correct, other than the part IF the value is I will need too add more values to this list"

Ah - I have spotted your issue
Yongle code converted everything to lower case to keep life simple
- ie cell values compared to lower case list
- refer to post#4 where this was explained
Your list is a mix of upper and lower case
Amended code below removes the lower case test and now everything listed must exactly match up with what is in the cells


Change this

Select Case LCase(CurrentStatus)
   Case "Complete - Invoice Paid", "Not being progressed", "all received", "ordered", "Research"

To this where the values inside the quote marks EXACTLY match what is in the cells
(ensure upper and lower case is the same and all spaces the same etc)

Select Case CurrentStatus
   Case "Complete - Invoice Paid", "Not being progressed", "All received", "Ordered", "Research"

Is there anything anything else not working as you want ?

 

[DavidAndrew]

Hi Yongle,

I have changed the code as instructed (please see below). There are no changes to the outputs on my status sheet unfortunately

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 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
If sRow = 1 Then sRow = 2
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]

There is something you are not telling me and we need to find out what that is
I cannot control the testing if you do anything other than what I ask in EXACTLY the same order

Test EXACTLY like this in EXACTLY this order

create a NEW workbook
Paste code below into ThisWorkbook code window
Add 2 new sheets(Sheet2 and Sheet3)

Sheet3
Rename Sheet3 "Status"
In sheet named "Status"
formula in cell A1
="Hdr"&Column()
Drag across to column BA
Go to cell A1 and then use shortcut {CTRL} a and then Copy&PasteValues without changing cells

activate Sheet2
place formula in cell A1
="Hdr"&Column()
drag that across to column CO
place formula in cell A2
=COLUMN()&"_"&ROW()
drag that across to column CO
Go to cell A1 and use shortcut {CTRL} a and then Copy & PasteValues without changing cells

activate sheet named "Status"
NOTE - it contains only header row

activate Sheet2
Amend value in G2 to "Research"

activate sheet named "Status"
NOTE- it now contains the copied row

activate Sheet2
amend value in A2 to "JobDone"

activate sheet named "Status"
NOTE - it now contains the copied row with the latest amendment

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 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
    If sRow = 1 Then sRow = 2
    Target.Resize(, 3).Copy .Cells(sRow, "A") 'copy A:C
    Target.Offset(, 6).Copy .Cells(sRow, "D") 'copy G
    Debug.Print Target.Offset(, 44).Resize(, 49).Address(0, 0)
    Target.Offset(, 44).Resize(, 49).Copy .Cells(sRow, "E") 'copy AS:CO
    End With
    Application.EnableEvents = True
End Sub

IMPORTANT
- the above is the code you posted in post#38 which works perfectly
- the above list of instructions have been double checked and everything does exactly what it should

If it does not work for you then you must be doing something wrong
- go back to the beginning of my instructions and start again with a new workbook and keep trying until it works

I look forward to your confirmation that you got it working

 

[DavidAndrew]

Hi Yongle,

I have created a new worksheet and followed the instructions which works exactly as you described, I can see that this is copying anything in column G across to tab status. I will try continue to work on the issue. I just wish I could show you my actual workbook for a while - I am sure it is something simple.

Many thanks again for your time and effort.

David

There is something you are not telling me and we need to find out what that is
I cannot control the testing if you do anything other than what I ask in EXACTLY the same order

Test EXACTLY like this in EXACTLY this order

create a NEW workbook
Paste code below into ThisWorkbook code window
Add 2 new sheets(Sheet2 and Sheet3)

Sheet3
Rename Sheet3 "Status"
In sheet named "Status"
formula in cell A1
="Hdr"&Column()
Drag across to column BA
Go to cell A1 and then use shortcut {CTRL} a and then Copy&PasteValues without changing cells

activate Sheet2
place formula in cell A1
="Hdr"&Column()
drag that across to column CO
place formula in cell A2
=COLUMN()&"_"&ROW()
drag that across to column CO
Go to cell A1 and use shortcut {CTRL} a and then Copy & PasteValues without changing cells

activate sheet named "Status"
NOTE - it contains only header row

activate Sheet2
Amend value in G2 to "Research"

activate sheet named "Status"
NOTE- it now contains the copied row

activate Sheet2
amend value in A2 to "JobDone"

activate sheet named "Status"
NOTE - it now contains the copied row with the latest amendment

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 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
    If sRow = 1 Then sRow = 2
    Target.Resize(, 3).Copy .Cells(sRow, "A") 'copy A:C
    Target.Offset(, 6).Copy .Cells(sRow, "D") 'copy G
    Debug.Print Target.Offset(, 44).Resize(, 49).Address(0, 0)
    Target.Offset(, 44).Resize(, 49).Copy .Cells(sRow, "E") 'copy AS:CO
    End With
    Application.EnableEvents = True
End Sub

IMPORTANT
- the above is the code you posted in post#38 which works perfectly
- the above list of instructions have been double checked and everything does exactly what it should

If it does not work for you then you must be doing something wrong
- go back to the beginning of my instructions and start again with a new workbook and keep trying until it works

I look forward to your confirmation that you got it working