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

johnmpc

New Member
Joined
Oct 19, 2020
Messages
32
Office Version
  1. 365
Platform
  1. Windows
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,500
Office Version
  1. 365
Platform
  1. Windows
If Sheet1 and Sheet2 already exist, and are named "Sheet1" and "Sheet2", this amendment to my code should do what you want:
VBA Code:
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
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

johnmpc

New Member
Joined
Oct 19, 2020
Messages
32
Office Version
  1. 365
Platform
  1. Windows
Order Template page. Q31 - AF44 Is the main area of concern

Quote Template.jpg



Email order version.jpg
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,500
Office Version
  1. 365
Platform
  1. Windows
Order Template page. Q31 - AF44 Is the main area of concern
Try this, which has been retrofitted your format:
VBA 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("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

Well-known Member
Joined
Jul 5, 2014
Messages
17,957
Office Version
  1. 2013
Platform
  1. Windows
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,500
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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:
VBA Code:
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

New Member
Joined
Oct 19, 2020
Messages
32
Office Version
  1. 365
Platform
  1. Windows
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

Update.jpg
Error.jpg
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,957
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

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

johnmpc

New Member
Joined
Oct 19, 2020
Messages
32
Office Version
  1. 365
Platform
  1. Windows
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,500
Office Version
  1. 365
Platform
  1. Windows

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
59,500
Office Version
  1. 365
Platform
  1. Windows
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:
VBA 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:
VBA Code:
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.
 

Forum statistics

Threads
1,144,424
Messages
5,724,249
Members
422,542
Latest member
jedidia

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top