Posts by royUK

royUK · 2020-07-08T18:47:05+01:00

Pleased to help

royUK · 2020-07-08T15:35:18+01:00

I wouldn't use such a control. If you want to slect a file use this

Code

Dim oFileDialog As Object
Dim vSelectedFile As Variant
Dim FilPath As String
Me.Hide
''///Browse for file
Set oFileDialog = Application.FileDialog(3)
With oFileDialog
.ButtonName = "Select File"
.AllowMultiSelect = False
.Filters.Clear ''///It is important to clear old filters before adding new one
.Filters.Add "Excel File", "*.xls*", 1 ''///You may add more filters and give them a sequence
.Title = "Select Input file"
.Show
For Each vSelectedFile In .SelectedItems
FilPath = vSelectedFile ''///get the path to the file to open
Next
End With
''/// open workbook
Workbooks.Open FilPath

Display More

royUK · 2020-07-08T15:21:09+01:00

That's Common Dialog Class, I think you want the Common Dialog Control. I think this control is like the DatePicker control and is not always available.

Also, I think if you are running a 64-bit version then it will not be available

royUK · 2020-07-08T14:05:57+01:00

The video is no help. What do you expect to do with this control?

royUK · 2020-07-08T12:02:35+01:00

Select all the cells you don't want to be locked. These will be the specific cells that can be edited even after the sheet is protected.
Right-click on your selection, select Format Cells, and click on the Protection tab. (Alternatively, under the Home tab, click on the expansion icon next to Alignment, and in the Format Cells window go to the Protection tab.)
Uncheck "Locked" (which is checked by default) and click OK.
Go to Review -> Protect Sheet and press OK to protect the sheet. Any cells you didn't unlock under the Format Cells option (step 3 above) will be locked, while the unlocked cells will be editable.

royUK · 2020-07-08T09:27:06+01:00

This amendment adds currency formatting and autofits the two columns

Code

Private Sub CommandButton1_Click()
Dim Region As Range, rng As Range
Dim lRow As Long, dTotal As Double
If Len(RefEdit1.Value) > 0 Then
Set rng = Range(RefEdit1.Value).Offset(1)
Set Region = Range(rng, Cells(Rows.Count, rng.Column).End(xlUp))
Cells(Rows.Count, 6).End(xlUp).Offset(1).Value = Application.WorksheetFunction.Sum(Region)
Cells(Rows.Count, 6).End(xlUp).Offset(1).Style = "Currency"
Cells(Rows.Count, 5).End(xlUp).Offset(1).Value = Range(RefEdit1.Value)
End If
If Len(RefEdit2.Value) > 0 Then
Set rng = Range(RefEdit2.Value).Offset(1)
Set Region = Range(rng, Cells(Rows.Count, rng.Column).End(xlUp))
Cells(Rows.Count, 6).End(xlUp).Offset(1).Value = Application.WorksheetFunction.Sum(Region)
Cells(Rows.Count, 6).End(xlUp).Offset(1).Style = "Currency"
Cells(Rows.Count, 5).End(xlUp).Offset(1).Value = Range(RefEdit2.Value)
End If
If Len(RefEdit3.Value) > 0 Then
Set rng = Range(RefEdit3.Value).Offset(1)
Set Region = Range(rng, Cells(Rows.Count, rng.Column).End(xlUp))
Cells(Rows.Count, 6).End(xlUp).Offset(1).Value = Application.WorksheetFunction.Sum(Region)
Cells(Rows.Count, 6).End(xlUp).Offset(1).Style = "Currency"
Cells(Rows.Count, 5).End(xlUp).Offset(1).Value = Range(RefEdit3.Value)
End If
Columns("E:F").AutoFit
End Sub

Display More

royUK · 2020-07-08T08:49:59+01:00

Try this. it also puts the column header on the left

Code

Private Sub CommandButton1_Click()
Dim Region As Range, rng As Range
Dim lRow As Long, dTotal As Double
If Len(RefEdit1.Value) > 0 Then
Set rng = Range(RefEdit1.Value).Offset(1)
Set Region = Range(rng, Cells(Rows.Count, rng.Column).End(xlUp))
Cells(Rows.Count, 6).End(xlUp).Offset(1).Value = Application.WorksheetFunction.Sum(Region)
Cells(Rows.Count, 5).End(xlUp).Offset(1).Value = Range(RefEdit1.Value)
End If
If Len(RefEdit2.Value) > 0 Then
Set rng = Range(RefEdit2.Value).Offset(1)
Set Region = Range(rng, Cells(Rows.Count, rng.Column).End(xlUp))
Cells(Rows.Count, 6).End(xlUp).Offset(1).Value = Application.WorksheetFunction.Sum(Region)
Cells(Rows.Count, 5).End(xlUp).Offset(1).Value = Range(RefEdit2.Value)
End If
If Len(RefEdit3.Value) > 0 Then
Set rng = Range(RefEdit3.Value).Offset(1)
Set Region = Range(rng, Cells(Rows.Count, rng.Column).End(xlUp))
Cells(Rows.Count, 6).End(xlUp).Offset(1).Value = Application.WorksheetFunction.Sum(Region)
Cells(Rows.Count, 5).End(xlUp).Offset(1).Value = Range(RefEdit3.Value)
End If
End Sub

Display More

royUK · 2020-07-08T06:15:27+01:00

Why are you doing this?

royUK · 2020-07-08T06:04:44+01:00

I don't like using Selection, that relies on the user remembering to select the right range.

How is the data laid out, is it a Table? Can it be defined in the code? A small example workbook would help.

I'm also, wondering if the name could be stored as a name.

Code

ThisWorkbook.Names.Add Name:="NewName", _
RefersTo:=fileSaveName, Visible:=True

royUK · Tuesday, 3:05 pm

You can't exclude sheets with your code except by hiding the sheets which is probably not what you want

royUK · Tuesday, 3:04 pm

Try this

Code

Private Sub CommandButton1_Click()
Dim Region As Range, rng As Range
Dim lRow As Long, dTotal As Double
If Len(RefEdit1.Value) = 0 Then
dTotal = 0
Else
Set rng = Range(RefEdit1.Value)
Set Region = Range(rng.Offset(1, 0), Cells(Rows.Count, rng.Column).End(xlUp))
dTotal = Application.Sum(Region)
End If
If Len(RefEdit2.Value) = 0 Then
dTotal = 0 + dTotal
Else
Set rng = Range(RefEdit2.Value)
Set Region = Range(rng.Offset(1, 0), Cells(Rows.Count, rng.Column).End(xlUp))
dTotal = dTotal + Application.Sum(Region)
End If
If Len(RefEdit3.Value) = 0 Then
dTotal = 0 + dTotal
Else
Set rng = Range(RefEdit3.Value)
Set Region = Range(rng.Offset(1, 0), Cells(Rows.Count, rng.Column).End(xlUp))
dTotal = dTotal + Application.Sum(Region)
End If
Range("F2").Value = dTotal
End Sub

Display More

royUK · Tuesday, 1:26 pm

For speed I would use AutoFilter depending on the data layout. This code can be adapted

Code

'---------------------------------------------------------------------------------------
' Module : Module1
' DateTime : 24/09/2006 22:48
' Updated : 2014
' Author : Roy Cox (royUK)
' Website : more examples
' Purpose : Create a sheet for each unique name in data
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
' projects but please leave this header intact.
'---------------------------------------------------------------------------------------
Sub ExtractToSheets()
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim rData As Range, rList As Range
Dim rCl As Range
Dim sNm As String
Set ws = Sheets("Data")
'extract a list of unique names
'first clear existing list
With ws
Set rData = .Range("A1").CurrentRegion
.Columns(.Columns.Count).Clear
rData.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
Set rList = .Cells(1, .Columns.Count).CurrentRegion
Set rList = rList.Offset(1, 0).Resize(rList.Rows.Count - 1, _
rList.Columns.Count)
For Each rCl In rList
sNm = rCl.Text
'add new sheet (only if required-NB uses UDF)
If WksExists(sNm) Then
'so clear contents
Sheets(sNm).Cells.Clear
Else
'new sheet required
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count) 'move to end
wsNew.Name = sNm
End If
'AutoFilter & copy to relevant sheet
rData.AutoFilter Field:=1, Criteria1:=sNm
rData.Copy Destination:=Worksheets(sNm).Cells(1, 1)
Next rCl
End With
ws.Columns(Columns.Count).ClearContents 'remove temporary list
rData.AutoFilter 'switch off AutoFilter
MsgBox "Report completed", vbInformation, "Done"
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Display More

royUK · Tuesday, 1:24 pm

I need to see an example of the workbook. A refedit returns a range address as a String.

royUK · Tuesday, 8:48 am

It's not clear what your variables are, but try this

Code

Private Sub CommandButton1_Click()
Dim lRow As Long
lRow = Cells(Rows.Count, "A").End(xlUp).Row
If Len(RefEdit1.Value) = 0 Then
MsgBox "No range selected", vbCritical, "Selection required"
Exit Sub
End If
Set rng1 = Range(RefEdit1.Value)
If Len(RefEdit2.Value) = 0 Then
MsgBox "No range selected", vbCritical, "Selection required"
Exit Sub
End If
Set Rng2 = Range(RefEdit2.Value)
If Len(RefEdit3.Value) = 0 Then
MsgBox "No range selected", vbCritical, "Selection required"
Exit Sub
End If
Set Rng3 = Range(RefEdit3.Value)
Set Total = Range("F2:F" & lRow)
For i = 1 To lRow - 1
Total(i, 1) = rng1(i, 1) + Rng2(i, 1) + Rng3(i, 1)
Next
End Sub

Display More

royUK · Tuesday, 7:01 am

You need to read the Forum Rules, pay attention to cross posting!

royUK · Tuesday, 6:32 am

Maybe

Code

Private Sub CommandButton1_Click()
Dim lRow As Long
lRow = Cells(Rows.Count, "A").End(xlUp).Row
If Column1 Is Nothing Then Exit Sub
Column1 = RefEdit1.Value
Set rng1 = Range(Column1)
If Column2 Is Nothing Then Exit Sub
Column2 = RefEdit2.Value
Set Rng2 = Range(Column2)
If Column3 Is Nothing Then Exit Sub
Column3 = RefEdit3.Value
Set Rng3 = Range(Column3)
Set Total = Range("F2:F" & lRow)
For i = 1 To lRow - 1
Total(i, 1) = rng1(i, 1) + Rng2(i, 1) + Rng3(i, 1)
Next
End Sub

Display More

royUK · Tuesday, 6:26 am

Please read the Forum Rules and use Code Tags when posting code on the Forum. You need to add the code again properly because it is unreadable at the moment.

I also see no point in using SendKeys, that method is unreliable.

royUK · Tuesday, 6:25 am

Pleased to help.

royUK · Tuesday, 6:25 am

I'm not sure what is happenibg. I've tried setting the InitialFileName but that doesn't work. I'll keep looking.

Code

Sub SaveAsPDF()
Dim filesavename As String, fName As String
fName = ActiveWorkbook.Name
fName = Replace(fName, "xls*", "pdf")
filesavename = Application.GetSaveAsFilename(fName, fileFilter:="PDF (*.pdf), *.pdf")
If filesavename <> False Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filesavename, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
End Sub

Display More

royUK · Monday, 7:21 pm

Try this

Code

Sub Save_To_Z()
'
' Save_To_Z Macro
'
' Keyboard Shortcut: Ctrl+Shift+Z
'
ChDir "Z:\July"
With ActiveWorkbook
.SaveAs Filename:= _
"Z:\July\" & Left(.Name, Len(.Name) - 5) & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
.Close False ''/// change to True if you want to save changes
End With
End Sub

Display More

Posts by royUK

Handling blank RedEdits

Unable to use CommonDialog on UserForm

Unable to use CommonDialog on UserForm

Unable to use CommonDialog on UserForm

Lock only certain cells in Excel

Handling blank RedEdits

Handling blank RedEdits

A working code I'd like to simplify and/or get advice

Hopefully Easy to fix Code

User input to select a specific sheet upon opening

Handling blank RedEdits

Transferring line-spaced information to the other page one after another

Handling blank RedEdits

Handling blank RedEdits

Handling blank RedEdits

Handling blank RedEdits

Copy/Past code knocks out NumLock Key

Save file in different folder, as CSV, with unchanged filename

Hopefully Easy to fix Code

Save file in different folder, as CSV, with unchanged filename