VBA copy worksheet and delete columns based on value

Sparky1983

New Member
Joined
Feb 19, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hi

I have the following code working so that it copies the “Template” tab and renames it based on a table in the summary tab

Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value: ActiveSheet.Range("G5") = c.Value
Next
End Sub

The "Template" has pre-populated information up to column GE but a lot of this can be deleted each time (e.g. the first tab may need all the info in the first 40 columns but second tab may only need the first 24 columns)

I have therefore included in column B on “Summary” the number of columns required for each tab created but I am unsure on how to include this in the above so that it automatically deletes the excess columns not required and to then adjust the print range to show F2:Lastcolum133.

Any help would be much appreciated.

Thanks!
 

Some videos you may like

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Can you use the XL2BB tool or make a screen shot to show us how the data in column B of Summary looks?
 

Sparky1983

New Member
Joined
Feb 19, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Can you use the XL2BB tool or make a screen shot to show us how the data in column B of Summary looks?

Screen shot attached - column B is just a helper column I added which calculates the number of columns needed based on other information in the table (6+(I+J)*3)

1613821342171.png
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
You used 'Delete' in your narrative, but this code only hides the columns from one iteration to the next in your loop. If the columns were deleted then you would have to organize your data with the maximum columns required to the minimum columns required. Try the procedure and see if it meets your needs.

VBA Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, lc As Long, col As Long
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
lc = sh2.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
        col = c.Offset(, 1).Value + 2
        sh2.Cells(c.Row, col + 1).Resize(, lc - col).EntireColumn.Hidden = True
        sh1.Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = c.Value: ActiveSheet.Range("G5") = c.Value
        sh2.Columns.Hidden = False
    Next
End Sub
 

Sparky1983

New Member
Joined
Feb 19, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

You used 'Delete' in your narrative, but this code only hides the columns from one iteration to the next in your loop. If the columns were deleted then you would have to organize your data with the maximum columns required to the minimum columns required. Try the procedure and see if it meets your needs.

VBA Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, lc As Long, col As Long
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
lc = sh2.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
        col = c.Offset(, 1).Value + 2
        sh2.Cells(c.Row, col + 1).Resize(, lc - col).EntireColumn.Hidden = True
        sh1.Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = c.Value: ActiveSheet.Range("G5") = c.Value
        sh2.Columns.Hidden = False
    Next
End Sub

Thanks for this - this seems to hide the columns on the summary page rather than on the renamed "Template" tab.

To summarise what I am trying to achieve:
Step 1: Currently the "Template" is copied and then renamed to Co A, Co B etc.
Step 2: Then delete columns 13 onwards on Co A tab and column 10 onwards on Co B using my example (based on your comment it appears this is not possible?)

As an alternative I could update the template tab if there a way to adapt the following so that is automatically copies and pastes as each template is created i.e. copy the template, rename to Co A and then copy columns K:M on Co A tab 12 times starting in column N, copy the template, rename to Co B and then copy columns K:M on Co B tab 9 times
VBA Code:
Sub Copycolumns()
Range("K:M").Copy Range("N1").Resize(, 3 * Range("G6").Value)
End Sub

or if the only option is to just hide the columns on Co A and Co B tabs then again I can amend the Template tab but would mean including additional formulae which I thought may cause the workbook to run slower when creating multiple sheets.

Thanks again for your help/advice.
 

RicoS

Board Regular
Joined
May 1, 2019
Messages
60
Can't test at the moment, but I think the below should work if you want to delete the columns (make sure you save it first before trying!!). I never like using activesheet after copying, but probably the best option.

VBA Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 as Worksheet, c As Range, lc As Long, col As Long
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
lc = sh2.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
set sh3 = activesheet
with sh3
   .Name = c.Value
   .Range("G5") = c.Value
   col = c.Offset(, 1).Value + 2
   .Cells(c.Row, col + 1).Resize(, lc - col).EntireColumn.Delete
End With
Next
End Sub
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

I was reading the OP wrongly. Do the numbers in column B of Summary start with column A of Template, or do they start with a different column?
 

Sparky1983

New Member
Joined
Feb 19, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
I was reading the OP wrongly. Do the numbers in column B of Summary start with column A of Template, or do they start with a different column?
It starts with column A in the Template
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
I think this is what you are looking for.

VBA Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, lc As Long
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value: ActiveSheet.Range("G5") = c.Value
With ActiveSheet
    lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    .Cells(1, c.Offset(, 1).Value + 1).Resize(, lc - c.Offset(, 1).Value).EntireColumn.Delete
    lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    .PageSetup.PrintArea = .Range("F2", .Cells(Rows.Count, 6).End(xlUp)).Resize(, lc - 5).Address
End With
Next
End Sub
 

Sparky1983

New Member
Joined
Feb 19, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
I think this is what you are looking for.

VBA Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, lc As Long
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Summary")
For Each c In sh2.Range("A3", sh2.Cells(Rows.Count, 1).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value: ActiveSheet.Range("G5") = c.Value
With ActiveSheet
    lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    .Cells(1, c.Offset(, 1).Value + 1).Resize(, lc - c.Offset(, 1).Value).EntireColumn.Delete
    lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    .PageSetup.PrintArea = .Range("F2", .Cells(Rows.Count, 6).End(xlUp)).Resize(, lc - 5).Address
End With
Next
End Sub

Thanks, this worked well where the number of columns required was 15 or less but anything over 16 and it came up with a Run-time error '1004' with the following section highlighted:
.Cells(1, c.Offset(, 1).Value + 1).Resize(, lc - c.Offset(, 1).Value).EntireColumn.Delete
 

Watch MrExcel Video

Forum statistics

Threads
1,127,529
Messages
5,625,351
Members
416,096
Latest member
forevans

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