OK I have searched and searched on how to do this properly. Here goes. I have 2 workbooks. In the first workbook I have some userforms (nested userforms that create a user interface for data input that is then saved to worksheets). Each userform of course has controls. The 2nd workbook has the macros. I have a read and write macro in this workbook that is invoked at appropriate times for reading and writing. In some cases, I have special write scenarios that require a little more processing. I have been able to use the application.run approach to run the macros in the 2nd workbook from the 1st workbook userforms.
Here's where I'm stomped. The times where I have to special write scenarios, in order to do this, while in the 2nd workbook's macros, I need to refer back to the 1st workbook launch an alternative userform and then loop thru the controls (textboxes) and update certain textbox values. To attempt this, I was performing 'Application.Run ("'" & wb.Name & "'!showNA")' which will open and initialize the other userform in the 1st workbook. Then I want to loop thru it's controls using 'For Each ctrl In vbcompfrm.Designer.Controls' of which I can not get to work and have tried many different syntax and combinations. Help! I do have the extensibility reference checked in tools as well. I am a self taught vba hobbyist so please go easy on my approach :D Thank you so much.
'code in workbook 2'
Public Sub test(ByRef FRM)
Dim ctrl As MSForms.Control
Dim vbcompfrm As VBComponent
Dim SubStr As String
Dim MyArr() As Variant
Dim key As String
Dim ATTR As String
ReDim MyArr(1)
MyArr(0) = "first"
MyArr(1) = "second"
Set ws = wb.Worksheets("testws")
Application.Run ("'" & wb.Name & "'!showNA") 'this will show the userform NA form the first workbook'
'Application.Run ("'" & wb.Name & "'!hideNA")
With UserForms("tbls_RTU_NA")
Set vbcompfrm = wb.VBProject.VBComponents("NA") 'this is the userform in the first workbook, we want to loop thru the controls'
For Each ctrl In vbcompfrm.Designer.Controls 'not sure how to make this work'
With ctrl
For i = LBound(MyArr) To UBound(MyArr)
If .ControlTipText = MyArr(i) Then
datasplit = Split(MyArr(i), "_")
key = datasplit(0)
ATTR = datasplit(1)
.Text = SearchDataArray(StandardTableDataArray, "NA_" & key, ATTR) 'don't forget we need to set the value of the new text to the array value once we match the key
End If
Next i
End With
Next ctrl
End With
Related
First time programmer here, started teaching myself VBA a few days ago to write this. The goal is to have the code be able to reference two workbooks that are not constants. One is selected by the user and the other is running the macro. I have defined the workbooks in a sub statement previous, but when I try to reference it in a sub statement further down the line I get error '9' "subscript out of range." I have tried using call but it also came up with undefined errors (it could be that I don't understand the 'call' statement).
If you have an additional moment to look over my formula and make sure it is formatted correctly that would be a big help as well. I just know it is going to be a huge problem when I get there.
P.S. I just noticed that I have been spelling reference wrong in my code this entire time. Go ahead, laugh.
'''
Sub Openfile()
Dim FileToOpen As Variant, wbRefrence As Workbook
Dim wbOracle As Workbook
Set wbOracle = ThisWorkbook
FileToOpen = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Open Database File")
If FileToOpen = False Then
MsgBox "No file selected, cannot continue." 'If the user does not open a file this message is displayed
Exit Sub 'If no file is selected the program stops running
End If
Set wbRefrence = Workbooks.Open(FileToOpen)
Workbooks.Open (FileToOpen) 'If a file is selected it opens that file.
Call LoopTest1
End Sub
Sub LoopTest1()
Dim BlankCell As Boolean
Dim i As Long
'Loop until a blank cell is encountered
Do While BlankCell = False
i = i + 1
If Cells(i, "C").Value = "" Then
BlankCell = True 'When it reaches a blank cell BlankCell will now be true which ends the do while formula.
End If
Application.Workbooks("wbOracle").Sheets("Cancel Requisition Lines").Range("C16").Select
'Formula for "do while" condition
Selection.Formula = "=IF(INDEX(['wbRefrence']Sheet1!'A2000:M2000',MATCH(1,(['wbRefrence']Sheet1!'D:D'=['wbOracle']'Cancel Requisition Lines'!'C16')*(['wbRefrence']Sheet1!'E:E'=['wbOracle']'Cancel Requisition Lines'!'I16')*(['wbRefrence']Sheet1!'F:F'=['wbOracle']'Cancel Requisition Lines'!'J16'),0),9)>=['wbOracle']'Cancel Requisition Lines'!M:M, ""materials supplied"","""")"
Loop
End Sub
'''
You've got a great start to your code, so here are a few things to help get you on your way...
Always use Option Explicit.
Try to define your variables as close as possible to its first use (your current code is short enough to not matter much, its just a habit to get into).
The Call usage has been deprecated and it's not needed. If you want to call a function or sub, just use the name of that routine.
Also, if you have a sub call that is by itself in a single statement, the parens are NOT required to enclose the parameters. If you're making the call in a compound or assignment statement, you MUST use the parens.
A good habit is to always make it clear what workbook, worksheet, and range you are referencing with a fully qualified reference every single time. This one thing trips up so many VBA users.
For example, in your LoopTest1 code, you are referring to Cells. Without any qualifying reference, the VBA code assumes you are referring to the currently active worksheet (whichever and whereever that is). So define some intermediate variables and make it clear (see example below).
To help clear up any confusion in your LoopTest1 sub, I added some parameters so that you can work on any two workbooks you choose.
My own preference is to build up a complicated formula in a separate string variable so that I can examine it in the debugger and make sure it's exactly right. So you can see I defined a formulaText string and built up your formula.
I "corrected" a few things I found in the formula (but I cannot tell you it will work), including:
Using the FullName property of both workbooks in the formula (so you never have it hard-coded)
Using the Name property of the worksheet (so you never have it hard-coded)
Properly arranging the single-tick marks for the proper workbook/worksheet reference (overall, you were using too many single-ticks in your formula)
Only you can determine if the formula is actually what you want and if it works. But that might be a separate question :)
Option Explicit
Sub Openfile()
Dim wbOracle As Workbook
Set wbOracle = ThisWorkbook
Dim FileToOpen As Variant
FileToOpen = Application.GetOpenFilename( _
FileFilter:="Excel Workbooks (*.xls*),*.xls*", _
Title:="Open Database File")
If FileToOpen = False Then
MsgBox "No file selected, cannot continue."
Exit Sub
End If
Dim wbReference As Workbook
Set wbReference = Workbooks.Open(FileToOpen)
Workbooks.Open FileToOpen
LoopTest1 wbOracle, wbReference, "Cancel Requisition Lines"
End Sub
Sub LoopTest1(ByRef wbOracle As Workbook, _
ByRef wbReference As Workbook, _
ByVal oracleSheetName As String)
Dim wsOracle As Worksheet
Set wsOracle = wbOracle.Sheets(oracleSheetName)
Dim wsReference As Worksheet
Dim referenceCell As Range
Set wsReference = wbReference.Sheet1
Set referenceCell = wsReference.Range("C1")
Dim formulaText As String
Do While Not IsEmpty(referenceCell)
formulaText = "=IF(INDEX('[" & wbReference.Name & _
"]Sheet1'!A2000:M2000,MATCH(1,(['" & wbReference.FullName & _
"]Sheet1'!D:D=['" & wbOracle.FullName & _
"]" & wsOracle.Name & "'!C16)*('[" & wbReference.FullName & _
"]Sheet1!E:E=[" & wbOracle.FullName & _
"]" & wsOracle.Name & "'!'I16')*([" & wbReference.FullName & _
"]Sheet1!F:F=[" & wbOracle.FullName & _
"]" & wsOracle.Name & "'!'J16'),0),9)>=[" & wbOracle.FullName & _
"]" & wsOracle.Name & "'!M:M, ""materials supplied"","""")"
wsOracle.Range("C16").Formula = formulaText
Set referenceCell = ReferenceCell.Offset(1, 0)
Loop
End Sub
I'm still reasonably new to VBA and feel I'm punching a little above my weight, so hopefully someone can help.
I need to issue a spreadsheet to people in my company which they can fill out and send it back. This needs to be done multiple times, so I have tried to automate this as much as possible. The source data is pasted in an "input" tab - this is then pivoted by user and input into a template tab. I can select any user and run a macro which does this and exports the filled out template to a new workbook.
In this template tab, I have dependent drop-down lists, which I have done by data validation - this relies on named ranges from the "coding" tab, which is also exported. One named range shows a list of values, and the other indexes over this and matches it to the required cell, to ensure only valid combinations are shown.
My issue is that the new workbook must not contain any links to the master - it should function completely in its own right. However, something is going wrong with the data validation/named ranges. Either some named ranges are being deleted (I know which bit of code is doing that but without it you get prompted to update links) or the data validation formula links back to the original workbook and doesn't work. I cannot find another way of achieving what I need without this particular data validation set up, so I need to try and adjust my macro to cater for this.
Is it possible to simply copy the template and coding tabs, with all the data validation, to a new workbook and break all links to the original, so that there are no startup prompts and the drop-downs all work?
Sub Copy_To_New_Workbook()
Dim wb As Workbook
Dim name As String
Dim ExternalLinks As Variant
Dim x As Long
Dim strFolder As String, strTempfile As String
name = Worksheets("Control").Cells(14, 7).Value
Let FileNameIs = Range("Filepath").Value & Range("FileName").Value
Set wb = Workbooks.Add
ThisWorkbook.Worksheets("Coding").Copy Before:=wb.Sheets(1)
ActiveSheet.name = "Coding"
ThisWorkbook.Worksheets("Transactions").Copy Before:=Worksheets("Coding")
ActiveSheet.name = "Transactions"
With ActiveSheet.UsedRange
.Value = .Value
End With
Application.DisplayAlerts = False
Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
For x = 1 To UBound(ExternalLinks)
wb.BreakLink name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
Next x
Dim objDefinedName As Object
For Each objDefinedName In wb.Names
If InStr(objDefinedName.RefersTo, "[") > 0 Then
objDefinedName.Delete
End If
Next objDefinedName
On Error GoTo 0
wb.SaveAs Filename:=FileNameIs, FileFormat:=52
ActiveWorkbook.Close
End Sub
My workbook has three sheets(named Sheet1 ~ Sheet3) with TEXTBOXES.
This has a module.
Public dontDoThat As Boolean ' a public variable, visible throughout all your project you'll use to give way to synchronizing activity
Option Explicit
Sub Synchronize(txt As String, shtName As String)
dontDoThat = True ' set your public variable to True and prevent subsequent TextBox1_Change() events to run it again
Dim sht As Variant
For Each sht In Array("Sheet1", "Sheet2", "Sheet3")
If sht <> shtName Then Worksheets(sht).TextBox1.Text = txt
Next
dontDoThat = False ' set your public variable to False and allow subsequent TextBox1_Change() events to run it
End Sub
These code can synchronize the TEXTBOX on all sheets.
But It's only for Text.
If I type some text in TEXTBOX1 of Sheet1, the same text will be display in TEXTBOX1 of all other sheets.
but The search function does not work on other sheets.
After I typed some text on TEXTBOX1 of Sheet1 and When I press the enter key, The search function works only in Sheet1.
I want to trigger the enter keypress on Textboxes of all Sheets.
And these sheets also have TEXTBOX2.
Thus I want to know how to apply syncronization to TEXTBOX1 and TEXTBOX2 as well.
I need someone help.
Neo, I've done something like this before - where you create an autofilter either with Change event, or a specified KeyDown event (usually the Enter key - vbKeyReturn). Since you're using a KeyDown event, it wouldn't be overly exhaustive to use collections. You can, say, roll all of your TextBoxes in a collection either by name similarities, or by TypeName.
Specifically, for why I'm thinking you're having issues, perhaps loop through the Worksheets collection with an actual Worksheet object, and not a variant. And, since they're Worksheets objects, you can use OLEObjects.
Dim sht As WorkSheet
Dim x as Integer
x = 1
For Each sht In ThisWorkbook.WorkSheets
Do Until sht.OLEObjects("TextBox & x") is Nothing
If sht.Name <> shtName Then sht.OLEObjects("TextBox & x").Object.Text = txt
x = x + 1
Loop
Next
And even within that loop, you can do another loop to iterate over your multiple text boxes. Let us know how you want to proceed. Hope this helps...
I have a CommandButton which opens a UserForm and create a copied Sheet with the name of the ComboBox Value.
This is My Code:
Private Sub CommandButton1_Click()
[UserForm1].Show ' Open UserForm
End Sub
Private Sub CommandButton2_Click()
Dim ws As Worksheet
ActiveWorkbook.Sheets("Sheet1").Visible = True ' Unhide Sheet
Sheets("Sheet1").Copy _
Before:=ActiveWorkbook.Sheets("Sheet1") ' Copy Sheet
Set ws = ActiveSheet
ws.Name = ComboBox1.Value ' Name Sheet
[UserForm1].Hide ' Close UserForm
ActiveWorkbook.Sheets("Sheet1").Visible = False ' Hide Sheet again
End sub
Now my problem is, if there are two machines with name "Machine Type 1" Excel gets an Error. So what do i have to change in my code, that the second sheet would named e.g. "Machine Type 1 (2)?
Thanks for your help.
you could try this
Private Sub CommandButton1_Click()
If IsSheetThere(ComboBox1.Value) Then 'if some sheet with chosen name already there
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
With ActiveSheet 'reference just copied sheet
.UsedRange.Clear 'clear its content
Sheets("Sheet1").UsedRange.Copy ActiveSheet.Range("A1") ' copy Sheet1 content and paste into it
End With
Else 'otherwise
Sheets("Sheet1").Copy Before:=Sheets(Sheets.Count) ' make a copy of "Sheet1" sheet
ActiveSheet.Name = ComboBox1.Value 'and rename it as per chosen name
End If
Me.Hide
End Sub
Function IsSheetThere(shtName As String) As Boolean
On Error Resume Next
IsSheetThere = Not Sheets(shtName) Is Nothing
End Function
the code line:
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
is the one that leaves Excel the burden of somehow "counting" the number of already existing sheets with the chosen name, and name the new one appropriately
You can use the following sub which calls the below function, just apply the same logic using .Copy
Sub create_new_sheet_with_name(name As String, wb As Workbook, aftersheet As Variant)
Dim i As Integer
i = 2
If sheet_name_exists(name, wb) Then
Do While sheet_name_exists(name & " (" & i & ")", wb)
i = i + 1
Loop
wb.Sheets.Add(after:=aftersheet).name = name & " (" & i & ")"
Else
wb.Sheets.Add(after:=aftersheet).name = name
End If
End Sub
Function sheet_name_exists(name As String, wb As Workbook) As Boolean
For Each sheet In wb.Worksheets
If sheet.name = name Then
sheet_name_exists = True
Exit Function
End If
Next sheet
sheet_name_exists = False
End Function
here's an example of how to use the sub:
Sub test()
create_new_sheet_with_name "hi", ThisWorkbook, ThisWorkbook.Sheets(1)
'this adds a new sheet named "hi" to thisworkbook after thisworkbook.sheets(1)
End Sub
Technically this isn't an answer to this question... but it's better because it will help you solve this and many other coding tasks on your own.
There is a simple way to create VBA code for most basic tasks.
If there's something Excel can do that you want to be able to do programmatically, just Record a Macro of yourself performing the action(s), and then look at the code that Excel generated.
I have a terrible memory, I can't remember commands I used yesterday. So it's not only quicker and less frustrating for others for me to figure it out myself, but the more often I do that, the quicker I'll learn (without asking others to do the thinking for me on a basic question).
I fact, I'm guess that the majority of veteran VBA coders learned at least partly by analyzing recorded macros. I know I did.
I'm in the process of refactoring a huge workbook woth a lot of legacy parts, redundant computations, cross-dependencies etc.
Basically, I'm trying to remove unneeded sheets and implement some proper information flow within the workbook. Is there a good way to extract the dependencies between the sheets (with VBA)?
Thanks
Martin
You can use ShowPrecedents and NavigateArrow.
here is some pseudocode
for each oCell in oSht containing a formula
ocell.showprecedents
do until nomoreprecedents
i=i+1
Set oPrec = oCell.NavigateArrow(True, 1, i)
If not oPrec.Parent Is oSht Then
' off-sheet precedent
endif
loop
next ocell
I came up with a little sub to do this. It moves all the sheets into seperate workbooks and prints out the dependencies. The advantage over using showPrecedents is that it captures all links including names, embedded forms/diagramms etc.
Word of warning: Moving worksheets isn't undo-able, save your workbook before running this and close (without saving) and re-open afterwards.
Sub printDependencies()
' Changes workbook structure - save before running this
Dim wbs As VBA.Collection, wb As Workbook, ws As Worksheets
Dim i As Integer, s As String, wc As Integer
Set ws = ThisWorkbook.Worksheets
Set wbs = New VBA.Collection
wbs.Add ThisWorkbook, ThisWorkbook.FullName
For i = ws.Count To 2 Step -1
ws(i).Move
wc = Application.Workbooks.Count
wbs.Add Application.Workbooks(wc), Application.Workbooks(wc).FullName
Next
Dim wb As Workbook
For Each wb In wbs
For Each s In wb.LinkSources(xlExcelLinks)
Debug.Print wb.Worksheets(1).Name & "<-" & wbs(s).Worksheets(1).Name
Next
Next
End Sub
The code isn't very polished or user-friendly, but it works.
You can follow the steps at "Find external references that are used in cells" topic of the following link:
Find external references in a worbook
But instead of enter the "[" you should enter the name of the sheet you're trying to find its dependencies. It will display a large list of every single cell referencing the sheet, but at the end it works. Haven't find the way to group by Sheet.