Posts by royUK

royUK · 2021-04-11T07:25:28+01:00

Welcome to the Forum

Please start your own post. Posting in another member's Thread is known as hijacking and is not allowed here. By all means add a link to a Thread that may be related to your question.

royUK · 2021-04-10T11:46:24+01:00

I tried similar code, but, as in Carim's example, the macro doesn't run but you simply end up selecting the button.

royUK · 2021-04-10T10:52:31+01:00

Unfortunately, I don't think disabling the button stops the assigned macro from running.

You need to amend the macro to check A1's value.

royUK · 2021-04-10T10:34:04+01:00

Done some more experimenting and this works

Code

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a1")) Is Nothing Then Exit Sub
Dim shp As Shape
Set shp = Me.Shapes("Button 1")
With shp
If UCase(Target.Value) = "OK" Then
.ControlFormat.Enabled = False '---> Disable the button
.TextFrame.Characters.Font.ColorIndex = 15 '---> Grey out button label
Else
With shp
.ControlFormat.Enabled = True '---> Enable the button
.TextFrame.Characters.Font.ColorIndex = 1 '---> Highlight button label
End With
End If
End With
End Sub

Display More

royUK · 2021-04-10T10:16:15+01:00

I t doesn't seem you can disable forms control buttons now. I've tried various codes with no luck.

royUK · 2021-04-10T09:08:02+01:00

The best I can come up with is to hide the button

Code

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a1")) Is Nothing Then Exit Sub
Dim oBut As Shape
Set oBut = ActiveSheet.Shapes(1)
oBut.Visible = Not UCase(Target.Value) = "OK"
End Sub

royUK · 2021-04-10T08:27:07+01:00

Using an ActiveX commandbutton.

Code

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a1")) Is Nothing Then Exit Sub
CommandButton1.Enabled = UCase(Target.Value) = "OK"
End Sub

royUK · Friday, 3:41 pm

I forgot to change on inee.

Change one line

Code

oWb.Close SaveChanges:=False

should be

Code

oWb.Close SaveChanges:=True

royUK · Friday, 3:15 pm

I've edited the code slightly

Code

Option Explicit
Sub LoopFiles()
Dim oWb As Workbook
Dim sFldr As String, sFilName As String
Dim fDialog As Object
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
If fDialog.Show = -1 Then
sFldr = fDialog.SelectedItems(1)
Else: MsgBox "User cancelled selection"
Exit Sub
End If
sFilName = Dir(sFldr & "\*.xls*")
Do While sFilName > ""
Set oWb = Workbooks.Open(sFldr & "\" & sFilName)
PageSetUp
oWb.Close SaveChanges:=False ''///Close opened worbook w/o saving, change as needed
sFilName = Dir()
Loop
MsgBox "All files updated", vbInformation, "Success"
End Sub
Sub PageSetUp()
With ActiveSheet.PageSetUp
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetUp.PrintArea = ""
With ActiveSheet.PageSetUp
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.708661417322835)
.RightMargin = Application.InchesToPoints(0.708661417322835)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
End Sub

Display More

royUK · Friday, 2:48 pm

Have you tried what I posted?

royUK · Friday, 2:04 pm

Try this. I've left all the options that you can change in the PageSetup for reference. I haven't checked it so let me know if it needs any amendments

Code

Option Explicit
Sub LoopFiles()
Dim oWb As Workbook
Dim sFldr As String, sFilName As String
Dim fDialog As Object
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
If fDialog.Show = -1 Then
sFldr = fDialog.SelectedItems(1)
Else: MsgBox "User cancelled selection"
Exit Sub
End If
sFilName = Dir(sFldr & "\*.xls*")
Do While sFilName > ""
Set oWb = Workbooks.Open(sFldr & "\" & sFilName)
oWb.Sheet(1).Select
PageSetUp oWb.Sheet(1)
Selection.ColumnWidth = 10
oWb.Close SaveChanges:=False ''///Close opened worbook w/o saving, change as needed
sFilName = Dir()
Loop
MsgBox "All files updated", vbInformation, "Success"
End Sub
Sub PageSetUp(sh As Worksheet)
With sh.PageSetUp
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
sh.PageSetUp.PrintArea = ""
With sh.PageSetUp
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.708661417322835)
.RightMargin = Application.InchesToPoints(0.708661417322835)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
End Sub

Display More

royUK · Friday, 1:52 pm

Pleased to help.

Post back if you need further help.

Visit my web site, http://www.excel-it.com, for more examples and some helpful articles.

royUK · Friday, 12:19 pm

I haven't used it but it's better than relying on macros. Do a trial and post back here.

royUK · Friday, 12:09 pm

The only efficient way to share a workbook is to use Collaboration, unfortunately it is only available if you use Office 365

royUK · Friday, 9:10 am

If you want to adjust multiple sheets within each workbook use

Code

Sheets.Select
Selection.ColumnWidth = 10

Code

Sub LoopFiles()
Dim oWb As Workbook
Dim sFldr As String, sFilName As String
Dim fDialog As Object
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
If fDialog.Show = -1 Then
sFldr = fDialog.SelectedItems(1)
Else: MsgBox "User cancelled selection"
Exit Sub
End If
sFilName = Dir(sFldr & "\*.xls*")
Do While sFilName > ""
Set oWb = Workbooks.Open(sFldr & "\" & sFilName)
oWb.Sheets.Select
' oWb.Sheet(1).Cells.Select
Selection.ColumnWidth = 10
oWb.Close SaveChanges:=False ''///Close opened worbook w/o saving, change as needed
sFilName = Dir()
Loop
MsgBox "All files updated", vbInformation, "Success"
End Sub

Display More

royUK · Friday, 9:05 am

Try this. The code assumes each workbook has one sheet.

Code

Sub LoopFiles()
Dim oWb As Workbook
Dim sFldr As String, sFilName As String
Dim fDialog As Object
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
If fDialog.Show = -1 Then
sFldr = fDialog.SelectedItems(1)
Else: MsgBox "User cancelled selection"
Exit Sub
End If
sFilName = Dir(sFldr & "\*.xls*")
Do While sFilName > ""
Set oWb = Workbooks.Open(sFldr & "\" & sFilName)
oWb.Sheet(1).Cells.Select
Selection.ColumnWidth = 10
oWb.Close SaveChanges:=False ''///Close opened worbook w/o saving, change as needed
sFilName = Dir()
Loop
MsgBox "All files updated", vbInformation, "Success"
End Sub

Display More

royUK · Friday, 6:17 am

Quote

Tried running the code and it is basically a dead duck

That doesn't provide any help as to why it's not working. Twice I've asked to see the workbook!

royUK · Thursday, 4:10 pm

As I said, it would help to see your workbook.

royUK · Thursday, 3:25 pm

This will add a unique identifier based on the time it is saved. Note that you must reset DisplayAlerts as well

Code

Sub export111()
Dim fName As String, fPath As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
fPath = "\\global.\"
ThisWorkbook.Worksheets("Dates").Range("H1").Value = Format(Now, "mm/dd/yyyy")
fName = ThisWorkbook.Worksheets("BCS").Range("G4").Value & "-" & "Period" & "-" & ThisWorkbook.Worksheets("Dates").Range("I1").Value & "-" & Format(Now, "hhmmss")
ThisWorkbook.SaveCopyAs Path & fName, FileFormat:=51
Application.DisplayAlerts = True
End Sub

Display More

It would help to see your file

royUK · Thursday, 2:45 pm

What range cannot be found?

Posts by royUK

Increment Cell Value & Print Sheet At Each Step

disable & enable button in activesheet based on cell value

disable & enable button in activesheet based on cell value

disable & enable button in activesheet based on cell value

disable & enable button in activesheet based on cell value

disable & enable button in activesheet based on cell value

disable & enable button in activesheet based on cell value

VBA to select the Width and Height to 1 page , Orientation as Landscape and Paper Size to Legal for multiple xlsx files in a folder

VBA to select the Width and Height to 1 page , Orientation as Landscape and Paper Size to Legal for multiple xlsx files in a folder

VBA to select the Width and Height to 1 page , Orientation as Landscape and Paper Size to Legal for multiple xlsx files in a folder

VBA to select the Width and Height to 1 page , Orientation as Landscape and Paper Size to Legal for multiple xlsx files in a folder

To Increase the width of the columns in a sheet for multiple files in a folder using VBA

Global Workbook Sharing code - need help

Global Workbook Sharing code - need help

To Increase the width of the columns in a sheet for multiple files in a folder using VBA

To Increase the width of the columns in a sheet for multiple files in a folder using VBA

Copying current workbook to new folder

Copying current workbook to new folder

Copying current workbook to new folder

Copying current workbook to new folder