Re: Offset copy with combobox choice
Hi Andy.
Works like a charm.
Thank you very much for your quick reply.
Thanks and regards.
John
Re: Offset copy with combobox choice
Hi Andy.
Works like a charm.
Thank you very much for your quick reply.
Thanks and regards.
John
In Sheet1 I have a button (Forms toolbar) that brings up a UserForm that has a ComboBox1 and a CommandButton (CmdOcc) on it. In Sheet2, ColumnA, I have a dynamic list with information named CelebDay. This list is loaded into the ComboBox. ColumnB in the same sheet has a dynamic list named CelebDate and the information in the cells is relevant to the cells to the left in ColumnA. When clicking on the CommandButton (CmdOcc), it copies the highlighted choice from ComboBox1 to cell G12 in Sheet1. However, I would like to copy the relevant cell info from ColumnB to cell A2 in Sheet1 at the same time. Is this possible without having to choose it through another combobox and if so, how would I go about this?
The CommandButton code is as follows:
Private Sub CmdOcc_Click()
Sheets("Sheet1").Range("G12").Value = ComboBox1.Value
Unload UserForm1
End Sub
Thanks in advance
John
Re: Stopping a macro from running with a macro
Hi Barry.
I have been at it for a few days again and found the following code that works like a charm (yet).
In This Workbook:
In Module1:
Dim blnGetOut As Boolean
------------------------
Sub StartCounting()
Do
Calculate
If blnGetOut Then Exit Do
DoEvents
Loop
blnGetOut = False
End Sub
Sub OUT()
blnGetOut = True
End Sub
Display More
All the credit for this goes to Jaafar (rafaaj2000)
Thank you again for your help Barry and I'll keep on working with your code also. Two (ways) is still better then one.
All that is left now is get a userform where I can enter the future date and time to be used for the countdown.
Regards.
John
Re: Stopping a macro from running with a macro
Barry.
Thanks a million. Taking your example with me.
John
Re: Stopping a macro from running with a macro
Barry.
Thank you for your reply. I looked up the DoEvents in the VB help but it is not quite clear to me yet. I will be out of town for the next 5 weeks and will have little or no possibility to check back on this site. If you would have an example for me, that would be much appreciated. Thanks again and have a good weekend.
John
I have a countdown on a sheet and it calculates automatically. When I try to exit with the X at the top right hand corner, the "Do you want to save" pop-up window comes up. Clicking on either Yes or No does not make a difference. The workbook opens again with the pop=up window asking if I want to enable or disable the macros in the workbook. A macro button on the worksheet gives the same results. The only way it closes is through the File - Exit - Save. I am sure that I have to stop the macro from running before I can close the workbook with the macro button. The only thing is that I don't know how to stop the macro from running in another macro.
In This Workbook:
In Module1:
Sub StartCounting()
Calculate
Application.OnTime Now + TimeValue("00:00:01"), "StartCounting"
End Sub
and
Sub CloseMe()
Application.DisplayAlerts = False
'Following could be False also
ActiveWorkbook.Close SaveChanges = True
Application.DisplayAlerts = True
End Sub
Any help is greatly appreciated.
Thanks and Regards
John
Re: Creating a PDF from VBA with Use of a Driver, Not Distiller
Hi summer brew and Jack in the UK.
I use Cute PDF which installs itself as a printer driver. Works great for me.
Good luck.
John
Re: Clearing Textboxes and Checkboxes
Hi Chas49.
I don't know if it will affect your code in the future but have a look at royUK's answer in the following thread regarding using "empty"'.
http://www.ozgrid.com/forum/showthread.php?t=35205
Good luck
John
Re: VBA decides if Chart or Sheet is active
Hi Hanss.
Works like a charm.
Thank you very much
Han (John)
I have a workbook with several sheets with Charts but it has also just chart sheets. I have short macros to change the Axes, Plot Area etc. At the moment I have different macros for the Charts and the worksheets as the choice for the Charts is i.e. ActiveChart.PlotArea.Select while for the charts in the sheets it is ActiveSheet.ChartObjects.Item(1).Activate. I would like to have just the one button where VBA decides which is active, a worksheet with a chart or a Chart. I have tried with Case Select but could not get anywhere with that. The same goes for If... Then....Else. I could not get that working either. Could someone get me going on the right track please.
Thanks and Regards.
John
Re: more items in validation drop down list and autocomplete
Hi.
Is this the link you're looking for?
http://www.ozgrid.com/forum/showthread.php?t=31312
John
Re: Filling shapes with pictures through a userform
You made my day Andy. Thank you very much. I'll get it all set up proper as soon as I have sufficient time as I am not the best at coding. Comes with, or because of, age I guess.
Thanks again
John
I am putting pictures in different shapes (squares, circles, maple leafs etc). These shapes are on Sheet3 and the names of the shapes, also in Sheet3, are in a variable range called TheShapes. The full path of the picture files are entered through VB on Sheet1 from cell Z11 on down and the variable range name is ThePicFiles. The code for getting the files is as follows:
In Sheet1 Codesheet:
Private Sub CommandButton1_Click()
Dim filenamelist() As Variant
Dim rng As Range
filenameslist = CreateFileList("*.jpg", False)
Set rng = Range("Z11", Range("Z65536").End(xlUp))
rng.ClearContents
If Not IsArray(filenameslist) Then
MsgBox "No files"
Exit Sub
End If
For i = 1 To UBound(filenameslist)
ActiveSheet.Cells(10 + i, 26).Value = filenameslist(i)
Next i
End Sub
Display More
In Module1:
Public strFolder As String
'' BIF_Options
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const BIF_BROWSEINCLUDEURLS = &H80
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_EDITBOX = &H10
Public Const BIF_NEWDIALOGSTYLE = &H40
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_SHAREABLE = &H8000
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_USENEWUI = &H40
Public Const BIF_VALIDATE = &H20
Public Const BIF_NONEWFOLDERBUTTON = &H200
'// Minimum DLL version shell32.dll version 4.71 or later
'// Minimum operating systems Windows 2000, Windows NT 4.0 with Internet Explorer 4.0,
'// Windows 98, Windows 95 with Internet Explorer 4.0
'// objFolder = objShell.BrowseForFolder(Hwnd, sTitle, BIF_Options [, vRootFolder])
Public Function BrowseForFolderShell( _
Optional Hwnd As Long = 0, _
Optional sTitle As String = "", _
Optional BIF_Options As Integer = BIF_VALIDATE, _
Optional vRootFolder As Variant) As String
Dim objShell As Object
Dim objFolder As Variant
Dim strFolderFullPath As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(Hwnd, sTitle, BIF_Options, vRootFolder)
If (Not objFolder Is Nothing) Then
'// NB: If SpecFolder= 0 = Desktop then ....
On Error Resume Next
If IsError(objFolder.Items.Item.path) Then strFolderFullPath = CStr(objFolder): GoTo GotIt
On Error GoTo 0
'// Is it the Root Dir?...if so change
If Len(objFolder.Items.Item.path) > 3 Then
strFolderFullPath = objFolder.Items.Item.path & Application.PathSeparator
Else
strFolderFullPath = objFolder.Items.Item.path
End If
Else
'// User cancelled
GoTo XitProperly
End If
GotIt:
BrowseForFolderShell = strFolderFullPath
XitProperly:
Set objFolder = Nothing
Set objShell = Nothing
End Function
Sub BrowseFavorites()
'// Using String
'// This will not only limit the User to a specific Folder
Dim strFolder As String
Dim objShell As Object
Dim objFolder As Variant
Dim strFolderFullPath As String
On Error Resume Next
Set objShell = CreateObject("Shell.Application")
'Set objFolder = objShell.Namespace(&H6)
Set objFolder = objShell.BrowseForFolder(0, "", BIF_BROWSEINCLUDEFILES, &H6)
On Error GoTo 0
If (Not objFolder Is Nothing) Then
'// NB: If SpecFolder= 0 = Desktop then ....
On Error Resume Next
If IsError(objFolder.Items.Item.path) Then strFolderFullPath = CStr(objFolder): GoTo GotIt
On Error GoTo 0
'// Is it the Root Dir?...if so change
If Len(objFolder.Items.Item.path) > 3 Then
strFolderFullPath = objFolder.Items.Item.path & Application.PathSeparator
Else
strFolderFullPath = objFolder.Items.Item.path
End If
Else
'// User cancelled
GoTo XitProperly
End If
GotIt:
'strFolderFullPath
XitProperly:
Set objFolder = Nothing
Set objShell = Nothing
If strFolderFullPath = vbNullString Then
MsgBox "You cancelled"
Else
MsgBox strFolder
End If
End Sub
Private Sub btnGetDetailsOf_Click()
Dim objShell As Shell
Dim objFolder As Folder
Set objShell = New Shell
Set objFolder = objShell.Namespace("C:\WINDOWS")
If (Not objFolder Is Nothing) Then
Dim objFolderItem As FolderItem
Set objFolderItem = objFolder.ParseName("clock.avi")
If (Not objFolderItem Is Nothing) Then
Dim szItem As String
szItem = objFolder.GetDetailsOf(objFolderItem, 2)
End If
Set objFolderItem = Nothing
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub
Function CreateFileList(FileFilter As String, _
IncludeSubFolder As Boolean) As Variant
' returns the full filename for files matching
' the filter criteria in the current folder
Dim FileList() As String, FileCount As Long
CreateFileList = ""
Erase FileList
If FileFilter = "" Then FileFilter = "*.*" ' all files
Debug.Print CurDir
strFolder = BrowseForFolderShell(, , , 0)
If strFolder = "" Then
MsgBox "You Cancelled"
Exit Function
End If
With Application.FileSearch
.NewSearch
.LookIn = strFolder
.Filename = FileFilter
.SearchSubFolders = IncludeSubFolder
.FileType = msoFileTypeAllFiles
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) = 0 Then Exit Function
ReDim FileList(.FoundFiles.Count)
For FileCount = 1 To .FoundFiles.Count
FileList(FileCount) = .FoundFiles(FileCount)
Next FileCount
.FileType = msoFileTypeExcelWorkbooks ' reset filetypes
End With
CreateFileList = FileList
Erase FileList
UserForm1.Show
End Function
Display More
(As you more then likely guessed, I did not write this marvelous code)
Right now, in Sheet1 I have a CommandButton from the Control Toolbox that brings up the "Browse for Folder" window and from which I select the folder with the picture files and enters the full path of the picture files in column Z. A ComboBox from the Control Toolbox that has the shape names in it for selection. A macro button to copy that shape from Sheet3 to Sheet1 and keep that shape selected. A macro button to fill the shape with a picture of which I have the full path copied to cell K12. Current code is as follows:
What I have been unsuccessfully trying to do is work everything through a Userform. I have the userform with two listboxes, one for the shape names and one for the picture file paths and a CommandButton which should copy the shape from Sheet3 to Sheet1 and fill that shape with a picture. Ideally, I would like to be able to select the folder with the picture files from the Userform also but as it stands, I am quite happy if I could get the userform to work so that when I highlight a picture file in ListBox1, highlight a shape in ListBox2 and click on the CommandButton that the shape will be copied from Sheet3 into Sheet1 and filled with that picture. I would have attached the file but it is 237KB. Can anyone help me with this? It is a long story and I hope I did not forget anything.
Thanks and regards.
John
Re: Find range through nearest number entry
Hi Batman.
Everything works great. Thanks a million for your help. Much appreciated.
Regards.
John
Re: Find range through nearest number entry
Hallo Batman.
Don't apologize for working. I sure appreciate you helping me. It works like a charm. Again, thank you very much. I've got an awful lot to learn yet about VBA. I have been trying to set the "SetFocus" to TextBox1. I would like to have the cursor in TextBox1 once the UserForm1 pops up on the screen. I use a small picture instead of a button to start the "Load UserForm1. I have put the "TextBox1.SetFocus" line wherever I could but I get an Error message everytime. (Run-time error 424: Object required). In Module1:
Sub PrintRangeChoice()
'I tried it here
Load UserForm1
'and here
UserForm1.Show
'and here also
End Sub
Is this because I use a picture? It is not important, but would be a nice touch.
Have a great weekend and again, thank you very much
John
Re: Find range through nearest number entry
It works for now with a very crude macro.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
'Copy the value in TextBox1 to cell Z1
Sheets("Printsheet").Range("Z1") = TextBox1.Value
'Copy the value in TextBox2 to cell Z2
Sheets("Printsheet").Range("Z2") = TextBox2.Value
'If the value of cell Z1 (=TextBox1) is less then the value of cell A12,
'replace the value of cell Z1 by the value of cell A12 (= first numerical entry)
If Sheets("Printsheet").Range("Z1").Value < Sheets("Printsheet").Range("A12").Value Then
Sheets("Printsheet").Range("Z1").Value = Range("A12").Value
End If
'Find the nearest value to cell Z1 value (=TextBox1 value) in cell Y1 with VLookup
Sheets("Printsheet").Range("Y1").Formula = "=VLookup(Z1,A12:A350, 1)"
'Find the nearest value to cell Z2 value (=TextBox2 value) in cell Y2 with VLookup
Sheets("Printsheet").Range("Y2").Formula = "=VLookup(Z2,A12:A350, 1)"
With Worksheets("Printsheet").Range("A12", Range("A65536").End(xlUp))
'Find the top row to be printed based on TextBox1 entry through Z1 and Y1
Set TopNumber = .Find(Range("Y1").Value, LookIn:=xlValues)
'Find the bottom row to be printed based on TextBox2 entry through Z2 and Y2
Set BottomNumber = .Find(Range("Y2").Value, LookIn:=xlValues)
'Offset the bottom to the most right column
Set BottomNumber = BottomNumber.Offset(0, 9)
'Print the selected range
Sheets("Printsheet").Range(TopNumber, BottomNumber).PrintOut Copies:=1, Collate:=True
End With
'Get rid of the userform
Unload Me
'Clear the temporary used range
Range("Y1:Z2").ClearContents
Application.ScreenUpdating = True
End Sub
Display More
Now the hard part starts by making it into an acceptable macro.
Any help is still very welcome
Thanks and regards.
John
Re: Find range through nearest number entry
Hi Batman.
Thank you for your reply. I have been trying with the "Application.WorksheetFunction.VLookup" method but so far no cigar. I'll keep on plugging away at it though. If you know of a way, I would greatly appreciate your help. I went through as many threads as I could find and some were close to what I am attempting but I have not been able to get it yet. I guess it is a problem when Excel is smarter than I am.
Thanks very much.
John
I have a UserForm with two Textboxes and a CommandButton. I need to print different ranges from a file and the values in this file are in two or more decimals. I would like to enter numbers in the text boxes without the decimals, or even better yet, just enter a number and the .Find method will choose the nearest value. It does not really matter if it finds the nearest value higher or lower. Preferably higher because this gives me the leeway of entering a number well past the highest entry for the "BottomNumber". The numbering is from low at the top to high at the bottom. There is an empty row every 5th line also.
Private Sub CommandButton1_Click()
Dim TopNumber As Range
Dim BottomNumber As Range
With Worksheets("Printsheet").Range("A12", Range("A65536").End(xlUp))
Set TopNumber = .Find(TextBox1.Value, LookIn:=xlValues)
Set BottomNumber = .Find(TextBox2.Value, LookIn:=xlValues)
Set BottomNumber = BottomNumber.Offset(0, 9)
Sheets("Printsheet").Range(TopNumber, BottomNumber).PrintOut Copies:=1, Collate:=True
End With
UserForm1.Hide
End Sub
Display More
Could someone point me in the right direction please.
Thanks in advance.
John
Re: Populate column with files from selected folder
Thank you very much for the replies.
The file from aadarsh works good. Would it be faster through a userform?
The file from Maqbool does not do anything in Excel 2003 and in Excel 2000 it gives a compile error (User-defined type not defined) highlighting the "Dim fdlogue As FileDialog" part.
I have not tried fengore's suggestion yet but I will as soon as I can.
Thanks and regards
John