How to project data from 1 sheet to another but remove columns with no data below header.

[johnmpc]

Hi All,

I have an input sheet for placing clothing orders. I then have a separate output sheet that displays the data in a way i can copy and paste what is needed to send back out.

I have Small medium large Xlarge XXlarge sizes in column headers, but what i want is if any columns below the header are empty i don't want to display the column or header.

Is that possible?

 

[Joe4]

If Sheet1 and Sheet2 already exist, and are named "Sheet1" and "Sheet2", this amendment to my code should do what you want:

Sub MyDeleteColumns()

    Dim lc As Long
    Dim c As Long
    Dim lr As Long
    
    Application.ScreenUpdating = False
    
'   Copy data from Sheet1 to Sheet2
    Sheets("Sheet1").Cells.Copy Sheets("Sheet2").Range("A1")
    
'   Find last column in row 1 with data (last header)
    Sheets("Sheet2").Activate
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
    
'   Loop through all columns
    For c = lc To 1 Step -1
'       Check to see if last row in column is 1
        If Cells(Rows.Count, c).End(xlUp).Row = 1 Then
'           Delete column
            Columns(c).Delete
        End If
    Next c
    
    Application.ScreenUpdating = True
    
End Sub

 

[johnmpc]

Order Template page. Q31 - AF44 Is the main area of concern

 

[Joe4]

Order Template page. Q31 - AF44 Is the main area of concern

Try this, which has been retrofitted your format:

Sub MyDeleteColumns()

    Dim lc As Long
    Dim c As Long
    Dim lr As Long
    
    Application.ScreenUpdating = False
    
'   Copy data from one sheet to other
    Sheets("Order Template").Range("Q30:AF44").Copy Sheets("Email order version").Range("T14")
    
'   Find last column in row 1 with data (last header)
    Sheets("Email order version").Activate
    lc = Cells(14, Columns.Count).End(xlToLeft).Column
    
'   Loop through all columns
    For c = lc To 20 Step -1
'       Check to see if last row in column is 14
        If Cells(Rows.Count, c).End(xlUp).Row = 14 Then
'           Delete column
            Columns(c).Delete
        End If
    Next c
    
    Application.ScreenUpdating = True
    
End Sub

FYI: This is a good example of why you want to provide as many details as possible. Unless you are good at adapting generic code to your situation, it is best to provide all the pertinent details, so we can tailor the response to your actual situation!

 

[My Aswer Is This]

Two things I have noticed. User has said this:

Ideally this will be dynamic so will automatically update the output sheet as the data is entered in the input sheet.
And:
I was thinking maybe there was a better way not using VBA.
Would it be possible to only "project" the columns that have data in?

 

[Joe4]

Two things I have noticed. User has said this:

Ideally this will be dynamic so will automatically update the output sheet as the data is entered in the input sheet.
And:
I was thinking maybe there was a better way not using VBA.
Would it be possible to only "project" the columns that have data in?

Not sure how to "project" it without VBA.

If they want something automated, they can use a Worksheet_Change event procedure code to autoamtically trigger the code to run any time a cell in the range Q31:AF44 is updated.
To do that, go to the "Order Template" tab, right-click on the sheet tab name, and select "View Code".
Then paste this code in the VB Editor window that pops up:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("Q31:AF44")) Is Nothing Then
        MyDeleteColumns
    End If
    
End Sub

This will call that other procedure I wrote automatically whenever a manual change is made in the range Q31:AF44.

However, if they have a lot of data to enter, I would question whether or not this is wise, as the code will run with every cell edit (it will be correct, it will just be a lot of code running).
In that case, I would think it may be better to add a button to that sheet that they can click to run the code once they have completed their data entry.

 

[johnmpc]

Thanks for your persistence. This is what i now get from the 1st bit of code.

The new bit to automate it comes back with an error when inputting in the data range

 

[My Aswer Is This]

Do you still have the previous code he wrote still in your workbook?
The second script is trying to run the first script

 

[johnmpc]

Managed to get the auto update to work. Had to tell it the code was in sheet11.

Couple of snags.

The positioning of the Data is obviously on T14 not J14. have tried just changing the T to J in the code but it adds all the columns back in.
Every entry of data it jumps to the 2nd sheet.
and the width of the columns doesn't transfer over.

Any updates for these, please?

 

[Joe4]

Do you still have the previous code he wrote still in your workbook?
The second script is trying to run the first script

That is correct. It is calling the other code, so you have to have the other code in there.

It is best to place that other code in a General Module.
See here if you do not know how to do that: Insert and run VBA macros in Excel - step-by-step guide - Ablebits.com

 

[Joe4]

Managed to get the auto update to work. Had to tell it the code was in sheet11.

You should really put the original code I posted in a General module, since it spans two sheets.

The positioning of the Data is obviously on T14 not J14. have tried just changing the T to J in the code but it adds all the columns back in.

Maybe obvious to you, but that image is so small, I can barely read it (my eyes aren't as good as they used to be).
Here is an update to that code:

Sub MyDeleteColumns()

    Dim lc As Long
    Dim c As Long
    Dim lr As Long
    
    Application.ScreenUpdating = False
    
'   Copy data from one sheet to other
    Sheets("Order Template").Range("Q30:AF44").Copy Sheets("Email order version").Range("J14")
    
'   Find last column in row 1 with data (last header)
    Sheets("Email order version").Activate
    lc = Cells(14, Columns.Count).End(xlToLeft).Column
    
'   Autofit columns
    Columns("J:Y").AutoFit
    
'   Loop through all columns
    For c = lc To 10 Step -1
'       Check to see if last row in column is 14
        If Cells(Rows.Count, c).End(xlUp).Row = 14 Then
'           Delete column
            Columns(c).Delete
        End If
    Next c
    
    Application.ScreenUpdating = True
    
End Sub

Every entry of data it jumps to the 2nd sheet.

We can make it go back to the original sheet by updating our other event procedure code like this:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("Q31:AF44")) Is Nothing Then
        MyDeleteColumns
        Sheets("Order Template").Activate
    End If
    
End Sub

and the width of the columns doesn't transfer over.

That is correct, as we are only copying over certain rows, and not the whole columns, so the column formatting does not come over with it.
I added a line of code to the procedure above to autofit the columns it copied over.
If you want to format it differently, you can record that part of the code, and paste it in.