Value of Sheet Cell Data to be referenced in code.

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows
HI
Hoping someone can help, I had a similar problem yesterday and was able to get that fix with the support of this forum Mr Excel . I have been trying to apply the same principle used yesterday in this code, that I wrote some time back. However the new updates do not fully work and I am a bit stuck again.

Reason for change in code
I will be creating copies of worksheets and have to keep using this code over and over again about 50+ times. Rather than do that, a command button will add the changed data to Sheet10 Cells D33 + D34 and the code will be called up from a module, it will use the changes in Sheet10 Cells D33, D34 every time it is run (This Data will keep changing on each command button Click)

Each command button will place different data in Sheet10 Cells D33 + D34
VBA Code:
Command Button1_Click ()
    Sheet10.Range("D33").Value = "Sheet1"     ' The text "Sheet1" will be added to Sheet10 D33
   Sheet10.Range("D34").Value = "Staff Data"    ' The text "Staff Data" will be added to Sheet10 D34
    Application.Run "Module2.CopySheet"    ' Code is written once and called as a module and will get data from Sheet 10
End Sub

These are the 5 parts that need Changing. The original code is commented out, FULL code is below
VBA Code:
'######## IF Statement See if Sheet has Data in it ###########    PART 1
'If Sheet1.Range("a2").Value = "" Then ' ******** ORIGINAL CODE ******
 If Sheets(Sheets("Sheet10").Range("D33").Value).Range("A2").Value = "" Then

''' ########## Copy This Sheet ############ PART 2
'.Sheets("Sheet1").UsedRange.Copy ' ******** ORIGINAL CODE ******
 .Sheets(Sheets("Sheet10").Range("D33").Value).UsedRange.Copy 

''' ########## Name of  New Sheet ############ PART 3               
'ActiveWorkbook.Sheets(1).Name = "Staff Data" ' ******** ORIGINAL CODE ******
 ActiveWorkbook.Sheets(1).Name = Sheets("Sheet10").Range("D34").Value 
                 
''' ############ column width ############# PART 4
'Worksheets("Staff Data").Columns("A:Z").ColumnWidth = 25  ' ******** ORIGINAL CODE ******
 Worksheets(Sheets("Sheet10").Range("D34")).Value.Columns("A:Z").ColumnWidth = 25
    
''''' ########### Name of Sheet + DATE + TIME ########## PART 5
'ActiveWorkbook.SaveAs "Staff Data" & Format(Now, " dd_mm_yyyy    HH_mm_ss") & ".xlsx" ' ******** ORIGINAL CODE ******
 ActiveWorkbook.SaveAs Sheets("Sheet10").Range("D34") & Format(Now, " dd_mm_yyyy    HH_mm_ss") & ".xlsx"
What the code is supposed to do
1) Create a copy of the Original Sheet, Format the header on the new sheet (Add Filter, Freezeframe, change font color of heading), Date/time stamp the new sheet, rename the new sheet tab with given name, Fill Blank cells with a hyphen.

If the original code is left in then it works FINE. I have got it to only half working with my changes. When I use my variation, a new workbook is created, however the new worksheet is Not Named, Dated, Timed, Data is not copied into it, nor is the workbook tab renamed to the new name, or freeze frame + filtered applied. The Original Sheet, from which the data was copied, ends up with the freeze frame and tab renamed.

Full code is below, With ORIGINAL CODE IN IT, but commented out
VBA Code:
'##### Export Staff DATA to excel #########

'######## IF Statement See if Sheet has Data in it ###########    PART 1
'If Sheet1.Range("a2").Value = "" Then ' ******** ORIGINAL CODE ******
If Sheets(Sheets("Sheet10").Range("D33").Value).Range("A2").Value = "" Then
ExportError.show
Else
    Application.SheetsInNewWorkbook = 1
        Workbooks.Add
    With ThisWorkbook

''' ########## Copy This Sheet ############ PART 2
'.Sheets("Sheet1").UsedRange.Copy ' ******** ORIGINAL CODE ******
.Sheets(Sheets("Sheet10").Range("D33").Value).UsedRange.Copy 'Copy this sheet

    ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
 
''' ########## Name of  New Sheet ############ PART 3               
'ActiveWorkbook.Sheets(1).Name = "Staff Data" ' ******** ORIGINAL CODE ******
ActiveWorkbook.Sheets(1).Name = Sheets("Sheet10").Range("D34").Value 
                
 On Error Resume Next      
''' ############ column width ############# PART 4
'Worksheets("Staff Data").Columns("A:Z").ColumnWidth = 25  ' ******** ORIGINAL CODE ******
Worksheets(Sheets("Sheet10").Range("D34")).Value.Columns("A:Z").ColumnWidth = 25
        
        Range("A1:Z1").Font.Name = "Calibri"
            Range("A1:Z1").HorizontalAlignment = xlCenter
                Range("A1:Z1").Font.Color = vbWhite
                    Range("A1:Z1").Interior.ColorIndex = 16 '.Color = vbGreen
                    
'''''Fill all BLANK CELLS with Hyphen
    Dim r As Range, LastRow As Long
        LastRow = Cells(Rows.Count, a).End(xlUp).Row
            For Each r In Range("A1:Z1" & LastRow)
        If r.Text = "" Then r.Value = "-"
    Next r
    
''''' ########### Name of Sheet + DATE + TIME ########## PART 5
'ActiveWorkbook.SaveAs "Staff Data" & Format(Now, " dd_mm_yyyy    HH_mm_ss") & ".xlsx" ' ******** ORIGINAL CODE ******
ActiveWorkbook.SaveAs Sheets("Sheet10").Range("D34") & Format(Now, " dd_mm_yyyy    HH_mm_ss") & ".xlsx"
          
      On Error Resume Next
      
''''''Freeze panel on new sheet
        Dim ws As Worksheet
            For Each ws In Worksheets
                 ws.Activate
                     With Application.ActiveWindow
                .SplitColumn = 0
            .SplitRow = 1
        End With
            Application.ActiveWindow.FreezePanes = True
                If Not ActiveSheet.AutoFilterMode Then
                ActiveSheet.Range("A1").AutoFilter

        End If
         Next ws
    End With
 End If

Thanks
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

ExcelGzh

Board Regular
Joined
Mar 29, 2020
Messages
130
Office Version
  1. 365
Platform
  1. Windows
Sharid

When you are working with data in different workbooks simultaneously, you need to be very careful that you are referencing the correct workbook. You have a With statement there that is referring to ThisWorkbook. That means that any reference that has a period in front of it, eg .Sheets, will be sourced from ThisWorkbook. Any reference that doesn't have a period will be sourcing its data from the ActiveWorkbook.

For example, you have a line
VBA Code:
.Sheets(Sheets("Sheet10").Range("D33").Value).UsedRange.Copy
The first reference to Sheets has a period in front of it, so this will be sourced from ThisWorkbook, but then the next reference to Sheets, Sheets("Sheet10") doesn't have a period in front of it, so this will be sourced from Sheet10 of the ActiveWorkbook.

Your line to save the new workbook is this
VBA Code:
ActiveWorkbook.SaveAs Sheets("Sheet10").Range("D34") & Format(Now, " dd_mm_yyyy    HH_mm_ss") & ".xlsx"

The part Sheets("Sheet10").Range("D34") does not have a period in front of it so it will be sourcing its value from cell D34 of Sheet10 of the ActiveWorkbook. Is this what you intended?

I suggest you go through your code carefully and make sure that every reference to a sheet or a range either has a period in front of it which means it will get its data from ThisWorkbook, or the reference has ActiveWorkbook. in front of it which means it will get its data from the ActiveWorkbook.
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows
Excel Gzh

Thanks for the update. I am not sure what I was thinking of when I started to make the changes. I think the problems is as you have stated, I am not always referencing the right workbook so it has nothing to use. My vba skills are very limited, so I don't always know what I am doing.

I have since re-written the code and most of it work well, I just have 3 issues

1) Does not rename tab
2) Does not save the workbook with new name and date/time stamp
3) When it copies the sheet it copies the VBA as well, I only want it to copy the SHEET data.

The code is supposed to use the data in Sheet1 of my workbook in the code when selecting a sheet to copy, name of new workbook and name of new tab. So far I only have the first part working. There is a downloadable workbook below

1608748448849.png


The new Code
VBA Code:
Private Sub CommandButton1_Click()
Dim ws As Worksheet

Application.ScreenUpdating = False
If Sheets(Sheets("Sheet1").Range("B1").Value).Range("A2").Value = "" Then
MsgBox "Nothing to export"
Else
        Sheets(Sheets("Sheet1").Range("B1").Value).Copy
        On Error GoTo 0

        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            On Error Resume Next ' I get error here
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select

' Format Header in new workbook
        ActiveWorkbook.Sheets(1).Range("A1:g1").Font.Name = "Calibri"
        ActiveWorkbook.Sheets(1).Range("A1:g1").HorizontalAlignment = xlCenter
        ActiveWorkbook.Sheets(1).Range("A1:g1").Font.Color = vbWhite
        ActiveWorkbook.Sheets(1).Range("A1:g1").Interior.ColorIndex = 16 'Color Grey
' Create a Freeze panel on new sheet
   Dim wks As Worksheet
        For Each wks In Worksheets
            wks.Activate
                With Application.ActiveWindow
                .SplitColumn = 0
            .SplitRow = 1
        End With
        Application.ActiveWindow.FreezePanes = True
            If Not ActiveSheet.AutoFilterMode Then
                ActiveSheet.Range("A1").AutoFilter
            End If
        Next wks
'Fill all BLANK CELLS with Hyphen
    Dim r As Range, LastRow As Long
        LastRow = Cells(Rows.Count, "A").End(xlUp).Row
        For Each r In ActiveWorkbook.Sheets(1).Range("A1:g" & LastRow)
        If r.Text = "" Then r.Value = "-"
    Next r
  
'######################### These two Parts Of the code are not working ###################
' Rename Tab On new Sheet
ActiveWorkbook.Sheets(1).Name = Sheets(Sheets("Sheet1").Range("B2").Value)
'Rename WorkBook and Save
ActiveWorkbook.SaveAs Sheets(Sheets("Sheet1").Range("B3").Value) & Format(Now, " dd_mm_yyyy    HH_mm_ss") & ".xlsx"
'######################### These two Parts Of the code are not working ###################
     
      Application.ScreenUpdating = True
End If
End Sub

Download Demo workbook Here
There are two buttons on Sheet 2
First button is old code and work. Second Button used data from Sheet1 to copy desired sheet, rename tab and workbook. For now only desired worksheet copy works

Hope someone can help, Thanks
 
Last edited:

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows
I have managed to fix problems 1 and 2 by doing this
VBA Code:
Dim TabName As Variant
TabName = ThisWorkbook.Worksheets("Sheet1").Range("B2").Value
ActiveWorkbook.Sheets(1).Name = TabName

'Rename Sheet
Dim SheetName As Variant
SheetName = ThisWorkbook.Worksheets("Sheet1").Range("B3").Value
ActiveWorkbook.SaveAs (SheetName) & Format(Now, " dd_mm_yyyy    HH_mm_ss") & ".xlsx"
I am now stuck on problem 3, it also copies the vba over
 

ExcelGzh

Board Regular
Joined
Mar 29, 2020
Messages
130
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

If you don't want all the code in each new sheet, what you need to do is create a Module and put the code in there. Modules are created in the vba editor by right-clicking a sheet name in the panel on the left, selecting Insert and then selecting Module (not Class Module - that's a different thing entirely). You will then have have a group called Modules with a module under it called Module1.

You then need to copy all the code out of Sheet1 into Module1. The copied procedure in Module1 needs to be given a new name which can be anything legal. The procedure in Sheet1 called CommandButton1_click needs to remain but instead of containing all the code it just has a call to the Module1 procedure.

For example, if you called the procedure in Module1 CopyData, then the code in Sheet1 would look like this
VBA Code:
Private Sub CommandButton1_Click()
CopyData
End Sub

Then when you copy Sheet1, CommandButton1_click with its call to CopyData gets copied across to the new sheet but there is still only one copy of the code that does all the work because Module1 doesn't get copied. When you make a copy of the entire workbook you would get a copy of Module1 because the module is part of the workbook. So each workbook would have a Module1 with its CopyData procedure and each sheet would have its own CommandButton1_click procedure making a call to the one CopyData procedure in Module1.

As a general comment on coding, as much code as possible should be kept in modules (you can have as many as you like and you can rename them) because the code in them is global across the workbook. Usually the only code in a sheet is code that is specific to that sheet such as events like Worksheet_Activate or Selection_Change or in this case CommandButton1_click and even then they quite often call code that is in a module.

Another thing you should do is put this line at the top of every module and vba sheet that has code (not all do)

VBA Code:
option explicit

Putting this line forces you to declare every variable. The advantage of this is that it prevents you making coding errors by misspelling variable names. If you declare a variable MyVariable and in the code put MyVarable the compiler will regard MyVarable as different to MyVariable and that will give all kinds of grief. With the Option Explicit line if you declare MyVariable and code MyVarable that will generate a compile error and you will be forced to fix it.

On the subject of declaring variables, I find debugging easier if I give variables meaningful names and also put a comment in the declaration line explaining what it is for.
VBA Code:
  Dim DDDialogResult As Long 'Daily Diary dialog box result
  Dim DDFileName As String 'Daily Diary file name
  Dim DDFolderPath As String 'Daily Diary folder path resulting from a FolderPicker dialog box
  Dim DDSheet As Worksheet 'Daily Diary sheet
  Dim DDWorkbook As Workbook 'Daily Diary workbook
  Dim JobAreaNum As Integer 'Job area number
  Dim LastPath As String 'Last file path for export or import of Daily Diary

It is amazing how when you come back to code you wrote a few months you forget what all the variables are for and you have to re-educate yourself on what is actually going on. Not to mention if someone else inherits your code and they have to try and work out what's going on.

Good luck with it all.
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows
ExcelGzh

The button code will be in a module, the problems is that each sheet will also have a bit of code in it, for sheet change events. this will also be copied over to the new workbook and it is this that I want to prevent, also it advise that the file can not be saved as a macro only file
1608758933681.png


If I click Yes it save with Chosen Workbook Name, Time and Date stamp + code

If I click No it still saves the code, BUT no Chosen workbook name , time or date stamp

I tried to change the file type from xlsx to xlsm but that did not help.


PS. I don't code often and forget as soon as i have learnt something. lol
 

ExcelGzh

Board Regular
Joined
Mar 29, 2020
Messages
130
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

If in this line
VBA Code:
ActiveWorkbook.SaveAs (SheetName) & Format(Now, " dd_mm_yyyy    HH_mm_ss") & ".xlsx"

you change xlsx to xlsm it saves as a macro-enabled file.

Is this where you changed to xlsm? I just tried it on my system and it worked fine.
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows
fixed the macro file issue, just need to get rid of the vba

VBA Code:
ActiveWorkbook.SaveAs (SheetName) & Format(Now, " dd_mm_yyyy    HH_mm_ss") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,047
Office Version
  1. 2016
Platform
  1. Windows
Is this where you changed to xlsm? I just tried it on my system and it worked fine.

It would not work for me, so I changed it to what I have
 

ExcelGzh

Board Regular
Joined
Mar 29, 2020
Messages
130
Office Version
  1. 365
Platform
  1. Windows
Could you send me another copy of what you currently have
 

Watch MrExcel Video

Forum statistics

Threads
1,127,653
Messages
5,626,105
Members
416,161
Latest member
David1966Lewis

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