Command Button to modify cell value in unknown name open workbook - vba

So the issue I'm having is we have a schedule program made via excel, that is set to replace all user names and shift times with "####" and where it would normally display names inputs "Contact blah blah for new version." This occured on 1/1/15. For now they can backdate their computer to a date prior to 1/1/15 and once they type a value in to any cell the worksheet runs and all their data re-appears. We have locations across the country that saves the file every two weeks to Wildcardname.xls I'm looking for a way to program a command button that finds the other random name opened workbook, goes to hidden sheet "help" and changes the value of Cell A184 to "01/01/2016" or any date I plug in. Which would remove the "####" issue and replace it with the originally inputed values. The user could then save the file and carry on.
I was browsing through various help boards and found this..prompts a user to select the workbook. This would be the workbook that needs changed.
http://www.excelforum.com/excel-programming-vba-macros/695467-copy-values-from-a-worksheet-to-another-workbook-source-workbook-name-unknown.html
Sub CopyData()
Dim DstRng As Range
Dim DstWkb As Workbook
Dim DstWks As Worksheet
Dim FileFilter As String
Dim Filename As String
Dim SrcRng As Range
Dim SrcWkb As Workbook
Dim SrcWks As Worksheet
Dim SheetName As String
SheetName = "Output Table"
FileFilter = "Excel Workbooks (*.xls), *.xls"
Filename = Application.GetOpenFilename(FileFilter, , "Open Source Workbook")
If Filename = "False" Then
MsgBox "Open Source File Canceled."
Exit Sub
End If
Set SrcWkb = Workbooks.Open(Filename)
Set SrcWks = SrcWkb.Worksheets(SheetName)
Set SrcRng = SrcWks.Range("A2:H20")
FileFilter = "Excel Workbooks (*.xls), *.xls"
Filename = Application.GetOpenFilename(FileFilter, , "Open Destination Workbook")
If Filename = "False" Then
MsgBox "Open Destination File Canceled."
Exit Sub
End If
Set DstWkb = Workbooks.Open(Filename)
Set DstWks = DstWkb.Worksheets(SheetName)
Set DstRng = DstWks.Range("A2:H20")
SrcRng.Copy Destination:=DstRng
End Sub
Can this be modified to accomplish what I want to complete?
I can't post an image yet, so here's a link to a mock up. Before shot of the program on the left, and on the right is what I want it to look like.
http://i528.photobucket.com/albums/dd330/DLN1223/mockup.jpg
Hopefully this description makes since....
Thanks in advance for your help.

This is what I use:
Dim FileToOpen As Variant
Dim WKbook as workbook
FileToOpen = Application.GetOpenFilename("Excel files (*.xlsx),*.xlsx", , "Select Workbook to Open")
If FileToOpen = False Then Exit Sub 'quit on cancel
Set Wkbook = Workbooks.Open(FileToOpen, False, False)
With this, I can the set the value I want, and save changes
Wkbook.Sheets("help").Range("A184")=#1/1/2016#
Wkbook.Close SaveChanges:=True
depending on the filetype, you may need to change Excel files (*.xlsx),*.xlsx to Excel files (*.xls),*.xls

Related

How do I make a macro that enables me to import data from one workbook to another ?B

Basically I would like to import data by clicking on a button assigned with the macro which would open the file browser, prompting the user to open the excel file they would like to import. I have tried to debug my codes but my For Each loop keeps getting an error, any help is appreciated!
Sub BrowseForFile()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
fileName = Application.GetOpenFilename(, , "Browse for Workbook")
Workbooks.Open (fileName)
For Each sheet In Workbooks(fileName).Worksheets
total = Workbooks("FIEP.xlsm").Worksheets.count
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("FIEP.xlsm").Worksheets(total)
Next sheet
Workbooks(fileName).Close
End Sub
Use a variable for the workbook object:
Sub BrowseForFile()
Dim directory As String, fileName As String, sheet As Worksheet, total As Long
Dim wb As Workbook
fileName = Application.GetOpenFilename(, , "Browse for Workbook")
Set wb = Workbooks.Open(fileName)
For Each sheet In wb.Worksheets
total = Workbooks("FIEP.xlsm").Worksheets.count
sheet.Copy after:=Workbooks("FIEP.xlsm").Worksheets(total)
Next sheet
wb.Close
End Sub
Remove the file path part. Variety of methods available. I used the one from here.
The Workbooks object is the collection of all the Workbook
objects that are currently open in the Microsoft Excel application.
It does not need the file path just the name. You could also have said ActiveWorkbook, though this would have been perhaps less robust.
Edit: Or as in #TimWilliam's answer, you can store the now open workbook in a variable and use that as the reference.
Option Explicit
Sub BrowseForFile()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
fileName = Application.GetOpenFilename(, , "Browse for Workbook")
Workbooks.Open (fileName)
Dim fso As New FileSystemObject 'Requires references to MS Scripting Runtime
fileName = fso.GetFileName(fileName)
For Each sheet In Workbooks(fileName).Worksheets '
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("FIEP.xlsm").Worksheets(total)
Next sheet
Workbooks(fileName).Close
End Sub

Getting File Location and Name for Excel VBA

I am creating a VBA program that will copy one column from one file to another.
The current code works, but I wish to change it to where a prompt will come up and ask the user for the file location and name / extension. That input will be imported as the file location for the Workbooks.Open function and go from there.
How do I create a prompt to ask for the user to input the file location and name for the desired excel file, and have it input in the Workbooks.Open function?
Code:
Sub Macro1()
Dim wb1 As Workbook
Dim wb2 As Workbook
MsgBox "Now converting data from Incident Data to Specific Data "
'Set it to be the file location, name, and extension of the Call Data CSV
Set wb1 = Workbooks.Open("Z:\xxxx\Call Data - Copy.csv")
'Set it to be the file location of the Working File
Set wb2 = Workbooks.Open("Z:\xxxx\Working File.xlsx")
wb1.Worksheets(1).Columns("E").Copy wb2.Worksheets(1).Columns("A")
wb1.Worksheets(1).Columns("I").Copy wb2.Worksheets(1).Columns("Q")
wb1.Worksheets(1).Columns("AE").Copy wb2.Worksheets(1).Columns("R")
wb1.Worksheets(1).Columns("BD").Copy wb2.Worksheets(1).Columns("F")
wb2.Close SaveCahnges:=True
wb1.Close SaveChanges:=True
End Sub
I would go with FileDialog to select an input file:
Dim fDialog As FileDialog, result As Integer
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
fDialog.AllowMultiSelect = False
fDialog.title = "Select a file"
fDialog.InitialFileName = "C:\"
fDialog.Filters.Clear
fDialog.Filters.Add "Excel files", "*.xlsx"
'Show the dialog. -1 means a file has been successfully selected
If fDialog.Show = -1 Then
Debug.Print fDialog.SelectedItems(1)
End If
For saving you can refer to this post
EDIT:
To use it in Workbooks.Open you just do something like the following:
Dim fname As String
If fDialog.Show = -1 Then
fname=fDialog.SelectedItems(1)
Else
MsgBox("Filename selection error")
Exit Sub
End If
Set wb1 = Workbooks.Open(fname)

Excel VBA writes data to second workbook, but starts opening read-only versions because " _ is already open

I have some VBA script in one Excel Workbook that has three subs that each either read from a second Workbook. Each of the subs uses the following algorithm (simplified to distill the interaction with the second book):
Public Sub EditRemote()
Dim remoteDataSheet As Worksheet
Dim source As String 'Source worksheet name
Dim target As String 'Target worksheet name
Dim path As String
Dim wkbName As String
source = "CountData"
path = ThisWorkbook.Worksheets("Parameters").Range("B2").Value
wkbName = ThisWorkbook.Worksheets("Parameters").Range("A2").Value
target = "CountData"
Application.EnableCancelKey = xlDisabled
Set localDataSheet = ThisWorkbook.Sheets(source)
If Not WorkbookIsOpen(wkbName) Then
Workbooks.Open (path)
End If
Set remoteDataSheet = Workbooks(wkbName).Sheets(source)
remoteDataSheet.Cells(1,1) = localDataSheet.Cells(1,1)
remoteDataSheet.Cells(1,2) = localDataSheet.Cells(1,2)
Workbooks(wkbName).Close SaveChanges:=True
End Sub
Function WorkbookIsOpen(targetWorkbook As String) As Boolean
Dim testBook As Workbook
On Error Resume Next
Set testBook = Workbooks(targetWorkbook)
If Err.Number = 0 Then
WorkbookIsOpen = True
Else:
WorkbookIsOpen = False
End If
End Function
There is also a pivot table in this Workbook that draws its data from the second file though an external data connection as well. The issue that is plaguing me is that it seems that not initially but after a few operations, these subs stop making the edits properly and instead it opens a read only copy of the second Workbook. When I try to open the second workbook manually I get a message saying that the file is already open and is locked for editing. Right now both files are local to my computer and couldn't be opened by anyone else. What am I missing to be sure that I can make the code work as intended?
I made some modification to your code, ran it a few times, and didn't get your "Read-only" message.
In your code the line of declaring localDataSheet is missing, added Dim localDataSheet As Worksheet , also added Dim remoteWb As Workbook for the remote workbook.
(didn't modify your Funtion WorkbookIsOpen code).
Sub EditRemote Code
Option Explicit
Public Sub EditRemote()
Dim remoteDataSheet As Worksheet
Dim localDataSheet As Worksheet
Dim source As String 'Source worksheet name
Dim target As String 'Target worksheet name
Dim path As String
Dim wkbName As String
Dim remoteWb As Workbook
source = "CountData"
path = ThisWorkbook.Worksheets("Parameters").Range("B2").Value
wkbName = ThisWorkbook.Worksheets("Parameters").Range("A2").Value
target = "CountData"
Application.EnableCancelKey = xlDisabled
Set localDataSheet = ThisWorkbook.Sheets(source)
' check if workbbok already open
If Not WorkbookIsOpen(wkbName) Then
Set remoteWb = Workbooks.Open(path)
Else
Set remoteWb = Workbooks(wkbName) ' workbook is open >> set remoteWb accordingly
End If
Set remoteDataSheet = remoteWb.Sheets(source)
remoteDataSheet.Cells(1, 1) = localDataSheet.Cells(1, 1)
remoteDataSheet.Cells(1, 2) = localDataSheet.Cells(1, 2)
Workbooks(wkbName).Close SaveChanges:=True
End Sub
Just to verify the data in your Excel "Parameters" sheet, the screen-shot below shows the data I used for my testing.
Cell A2 contains the "Clean" workbook name.
Cell B2 contains workbbok "full" name - path + "clean" workbook name.
After some further testing to diagnose the issue, I found that there was nothing wrong with the VBA code, but rather the external data connection to the remote Workbook was locking that Workbook every time I refreshed the data in the pivot table that used the external data connection as its source. It isn't unlocking the file when it is done refreshing, and that leaves the file locked until I close the Workbook with the pivot table. Now I just need to solve that problem.

Run the same VBA macro on different excel files with a button on my custom Ribbon

I've created a VBA macro and need to perform the same tasks on multiple different files. Ideally i'd like to create a button on my Ribbon and execute the tasks with the click of a button. How do I make the macro available to multiple files and execute the tasks using the data from a newly opened worksheet? I've added the macro to a PERSONALS.xlsb file and can see the macro available every time I open Excel, but the macro only executes the tasks on the PERSONALS.xlsb file, not the newly opened file.
Sub Export_Files()
Dim sExportFolder, sFN
Dim rDiscription As Range
Dim rHTMLcode As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object
'sExportFolder = path to the folder you want to export to
'oSh = The sheet where your data is stored
sExportFolder = "C:\Users\bhinton\Desktop\ActionTags"
Set oSh = Sheet1
Set oFS = CreateObject("Scripting.Filesystemobject")
For Each rDiscription In oSh.UsedRange.Columns("C").Cells
Set rHTMLcode = rDiscription.Offset(, 6)
'Add .txt to the article name as a file name
sFN = rDiscription.Value & ".html"
Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
oTxt.Write rHTMLcode.Value
oTxt.Close
Next
End Sub
Instead of
Set oSh = Sheet1
You need to use
Set oSh = ActiveSheet
Using ActiveSheet means that the code will use the newly opened workbook and the active sheet which I think is what you want.
Or if you always want Sheet1 of the currently active workbook, you can do this:
Set oSh = ActiveWorkbook.Worksheets("Sheet1")
Here's one way to prompt the user to select files then iterate through them:
Option Explicit
Sub OpenFilesAndIterate()
Dim DataDialog As FileDialog
Dim NumFiles As Long, Counter As Long
Dim MyWorkbook As Workbook
Dim MySheet As Worksheet
'prompt the user to select data files
Set DataDialog = Application.FileDialog(msoFileDialogOpen)
With DataDialog
.AllowMultiSelect = True
.Title = "Please pick the files you'd like to operate on:"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
'assign the number of files selected for an easy loop boundary
NumFiles = DataDialog.SelectedItems.Count
'check to see if the user clicked cancel
If NumFiles = 0 Then Exit Sub
'Start looping through and do work
For Counter = 1 To NumFiles
Set MyWorkbook = Workbooks.Open(DataDialog.SelectedItems(Counter))
Set MySheet = MyWorkbook.Worksheets("Sheet1")
'
'insert your code to operate on worksheet here
'
MyWorkbook.Save
MyWorkbook.Close SaveChanges:=False
Next Counter
End Sub
In the options for Excel, click on Customize Ribbon. Above the list of things you can add there should be a dropdown box where you can select Macros. The list should then be populated with macros to add to your ribbon!

Copy data from another Workbook through VBA

I want to collect data from different files and insert it into a workbook doing something like this.
Do While THAT_DIFFERENT_FILE_SOMEWHERE_ON_MY_HDD.Cells(Rand, 1).Value <> "" And Rand < 65536
then 'I will search if the last row in my main worksheet is in this file...
End Loop
If the last row from my main worksheet is in the file, I'll quit the While Loop. If not, I'll copy everything. I'm having trouble finding the right algorithm for this.
My problem is that I don't know how to access different workbooks.
The best (and easiest) way to copy data from a workbook to another is to use the object model of Excel.
Option Explicit
Sub test()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set targetworkbook
Set wb2 = ActiveWorkbook
'For instance, copy data from a range in the first workbook to another range in the other workbook
wb2.Worksheets("Sheet2").Range("C3:D4").Value = wb.Worksheets("Sheet1").Range("A1:B2").Value
End Sub
You might like the function GetInfoFromClosedFile()
Edit: Since the above link does not seem to work anymore, I am adding alternate link 1 and alternate link 2 + code:
Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "" Then wbPath = wbPath & ""
If Dir(wbPath & "" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
Are you looking for the syntax to open them:
Dim wkbk As Workbook
Set wkbk = Workbooks.Open("C:\MyDirectory\mysheet.xlsx")
Then, you can use wkbk.Sheets(1).Range("3:3") (or whatever you need)
There's very little reason not to open multiple workbooks in Excel. Key lines of code are:
Application.EnableEvents = False
Application.ScreenUpdating = False
...then you won't see anything whilst the code runs, and no code will run that is associated with the opening of the second workbook. Then there are...
Application.DisplayAlerts = False
Application.Calculation = xlManual
...so as to stop you getting pop-up messages associated with the content of the second file, and to avoid any slow re-calculations. Ensure you set back to True/xlAutomatic at end of your programming
If opening the second workbook is not going to cause performance issues, you may as well do it. In fact, having the second workbook open will make it very beneficial when attempting to debug your code if some of the secondary files do not conform to the expected format
Here is some expert guidance on using multiple Excel files that gives an overview of the different methods available for referencing data
An extension question would be how to cycle through multiple files contained in the same folder. You can use the Windows folder picker using:
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .Selected.Items.Count = 1 the InputFolder = .SelectedItems(1)
End With
FName = VBA.Dir(InputFolder)
Do While FName <> ""
'''Do function here
FName = VBA.Dir()
Loop
Hopefully some of the above will be of use
I had the same question but applying the provided solutions changed the file to write in. Once I selected the new excel file, I was also writing in that file and not in my original file. My solution for this issue is below:
Sub GetData()
Dim excelapp As Application
Dim source As Workbook
Dim srcSH1 As Worksheet
Dim sh As Worksheet
Dim path As String
Dim nmr As Long
Dim i As Long
nmr = 20
Set excelapp = New Application
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
.Show
path = .SelectedItems.Item(1)
End With
Set source = excelapp.Workbooks.Open(path)
Set srcSH1 = source.Worksheets("Sheet1")
Set sh = Sheets("Sheet1")
For i = 1 To nmr
sh.Cells(i, "A").Value = srcSH1.Cells(i, "A").Value
Next i
End Sub
With excelapp a new application will be called. The with block sets the path for the external file. Finally, I set the external Workbook with source and srcSH1 as a Worksheet within the external sheet.