Referencing Variables in a Different Sub Statement. Subscript Out of Range - excel

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

Related

Adding conditions to excel export worksheets loop

Currently learning VBA in bits and pieces.
Confused on where to insert a condition in the following piece to check each worksheet respectively on cell address E8 for example for ANY entry other than “”.
Sub SaveWorkshetAsPDF()
Dim ws As Worksheet
timestamp = Format(Date, "mmddyyyy ")
For Each ws In Worksheets
ws.Select
ws.ExportAsFixedFormat xlTypePDF, Filename:= _
ActiveWorkbook.Path & "\" & timestamp & ws.Name & ".pdf"
Next ws
End Sub
Any assistance would be amazing.
Want it to stop exporting if a value is present in a specified cell.
I think this should get you what you need. I included some comments that might help out a little and give you a method to have a condition to check.
A couple notes to improve:
Always good to define variable such as timestamp.
No need to actively select the sheet, you can get the file's workbook path using the parent property.
For items that are hard-coded, I'm a fan of putting the values at the top of the macro as constants. It makes changing things easier.
Hope this helps.
Sub SaveWorkshetAsPDF()
Const theValueToStop As String = "Stop" 'or whatever, if it's a number change to Long
Const theAdddress As String = "E8" 'makes it easier to find and change if needed.
Dim ws As Worksheet, timestamp As String
timestamp = Format(Date, "mmddyyyy ")
For Each ws In Worksheets
'no neeed to select use parent property for address.
'ws.Select
If ws.Range(theAdddress).Value <> theValueToStop Then
ws.ExportAsFixedFormat xlTypePDF, Filename:= _
ws.Parent.Path & "\" & timestamp & ws.Name & ".pdf"
End If
Next ws
End Sub

Loop thru controls on another workbooks userform

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

I want my code to transfer the sheet tab to an excel file that I only know the partial name of [duplicate]

This question already has an answer here:
How do I get my code to apply to a file in which I only know part of the name
(1 answer)
Closed 3 years ago.
Sub movedata_tab_to_2excelFile()
Windows("1excelfileInstructions and macrostest.xlsm"). _
Activate
Sheets("Data").Select
Sheets("Data").Copy Before:=Workbooks( _
"2excel File4253.xlsx").Sheets(3)
Windows("Instructions_and_macros_Test1.xlsm").Activate
End Sub
I want to move the data tab in [1excelfileInstructions and macrostest.xlsm] to 2excel File4253.xlsx and I have the macro stored in Instructions_and_macros_Test1.xlsm.
My problem is the excel file name of 2excel File4253.xlsx keeps changing and I only know the partial name of it. Is there anyway to run my code in which it can ignore the numbers before and after the excel file name like adding asterisks/wild card to it example excel File
if your Excel files are open then you can try to do the following:
Sub foo()
Dim wbkCount As Long
For wbkCount = 1 To Workbooks.Count
If Workbooks(wbkCount).Name Like "*excel File*" Then
Debug.Print "This is the one!" & Workbooks(wbkCount).Name
'do something
End If
Next wbkCount
End Sub
Basically the idea is for VBA to loop through all your open Workbooks and find the one that matches the name excel File. Once it is found, the code will perform the relevant action (replace Debug.Print and 'do something lines with your Copy statement).
Edit - full code:
Sub movedata_tab_to_2excelFile()
Dim wbkCount As Long
Windows("1excelfileInstructions and macrostest.xlsm"). _
Activate
For wbkCount = 1 To Workbooks.Count
If Workbooks(wbkCount).Name Like "*excel File*" Then
Sheets("Data").Copy Before:=Workbooks( _
Workbooks(wbkCount).Name).Sheets(3)
End If
Next wbkCount
Windows("Instructions_and_macros_Test1.xlsm").Activate
End Sub
Try this: (Tested)
Sub movedata_tab_to_2excelFile()
fnd = Dir("C:\Users\mohit.bansal\Desktop\Test\" & "*excel File*.xlsm") 'Change the Folder Path
If fnd <> "" Then
Workbooks("1excelfileInstructions and macrostest.xlsm.xlsm").Worksheets("Data").Copy Before:=Workbooks(fnd).Sheets(3)
End If
End Sub
Also there is no Need for Activate and Select. You should always avoid those when working with VBA
Sub movedata_tab_to_2excelFile()
Dim s as string
Const path2SecondFile = "C:\" 'your path here, ending with \
s=dir(path2secondfile & "*File4253*.xlsx") 'or whatever wildcard pattern will find it
if s = "" then
msgbox "Can't Find File",vbokonly,"File Not Found"
else
dim found as boolean
dim wb as workbook
for each wb in workbooks
if wb.name = s then
'file already loaded
found=true
exit for
end if
next wb
if not found then
Workbooks.open(path2secondfile & s) 'if necessary
end if
with thisworkbook.Sheets("Data")
.Copy Before:=Workbooks(s).Sheets(3)
end with
End IF
End Sub

Copy data from an Excel sheet to different files

I have an excel sheet which has some huge data. Data is organized as follows,
A set of 7 columns and n rows; as in a table, and 1000s of such tables are placed horizontally with an empty column to separate. A screenshot is below..
...
I just want to have data of every 'table' saved into a different file. Manually it would take ever! So, Is there a macro or something I would automate this task with.
I am not well versed with writing macros or any VBA stuff.
Thanks,
Tony has a valid point when he says
If the table starting at C1 finishes on row 21, does the next table start at C23? If the table starting at K1 finishes on row 15, does the next table start at K17 or K23?
So here is a code which will work in any condition i.e data is set horizontally or vertically.
DATA SNAPSHOT
CODE
'~~> Change this to the relevant Output folder
Const FilePath As String = "C:\Temp\"
Dim FileNumb As Long
Sub Sample()
Dim Rng As Range
Dim AddrToCopy() As String
Dim i As Long
On Error GoTo Whoa
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
If Not Rng Is Nothing Then
AddrToCopy = Split(Rng.Address, ",")
FileNumb = 1
For i = LBound(AddrToCopy) To UBound(AddrToCopy)
ExportToSheet (AddrToCopy(i))
Next i
End If
MsgBox "Export Done Successfully"
LetsContinue:
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
Sub ExportToSheet(rngAddr As String)
Range(rngAddr).Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:= _
FilePath & "Output" & FileNumb & ".csv" _
, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
FileNumb = FileNumb + 1
End Sub
NOTE: The above code will work for cells with only Text Values. For cells with only Numeric Values you have to use
Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
And for AlphaNumeric Values (As in your question above), use this
Set Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
HTH
Sid
As long as there is a blank row and a blank column around any datasets, this will use the AREAS() method to put them all in separate workbooks.
As per the prior example, it saves as CSV, but of course you can save it as you wish.
Option Explicit
Sub ExportDataGroups()
Dim fPATH As String, Grp As Long, DataRNG As Range
fPATH = "C:\Path\Where\I\Want\My\Files\Saved\" 'remember the final \
Application.ScreenUpdating = False
Set DataRNG = ActiveSheet.UsedRange
For Grp = 1 To DataRNG.Areas.Count
DataRNG.Areas(Grp).Copy
Sheets.Add
Range("A1").PasteSpecial
ActiveSheet.Move
ActiveWorkbook.SaveAs Filename:=fPATH & "-" & Format(Grp, "0000") & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Next Grp
MsgBox "A total of " & Grp & " files were created"
Application.ScreenUpdating = True
End Sub
In your response to my comment you state: "File name, I never thought about it. Could be anything for now." From bitter experience I can tell you that dealing with thousands of files with system generated names is a nightmare. You need to fix the name problem now.
I am also nervous about AddrToCopy = Split(Rng.Address, ","). Rng.Address will be of the form: "$C$1:$I$16, $K$1:$Q$16, $S$1:$Y$16, $C18$I$33, $K$18:$Q$33, $S$18:$Y$33, ...". If you search the internet you will find sites that tell you that Rng.Address has a maximum length of 253 characters. I do not believe this is correct. In my experience, Rng.Address is truncated at a complete sub-range. My experimentation was with Excel 2003 but I have found noting on the internet to suggest this limitation has been fixed in later versions of Excel. You much check Rng.Address with your version of Excel! I am not familar with Jerry Beaucaire, although he offers an interesting solution. Sid Rout always produces excellent code. If there is a problem, I am sure they will be able to fix it.
However, the real purpose of this "answer" is to say I would split this problem into three. This has lots of advantages and no disadvantages of which I am aware.
Step 1. Create a new worksheet, TableSpec, with the following columns:
A Worksheet name. (If tables are spread over more than worksheet)
B Range. For example: C1:I16, K1:Q16
C - I Headings from table. For example, AAPL, Open, High, Low, Close, Volume, AdjClose
Step 2. Check worksheet TableSpec; for example, are all table listed? Think about the file name and add column H to contain it. I read one of your comments to mean you would "AAPL" as the filename for the first table in which case you could set H2 to "=C2". Is "AAPL" unique? You could had a sequence number. There are lots of choices which you can think about before you generate any files.
Step 3. Worksheet TableSpec now gives all the information necessary to generate your files. You could delete most of the contents and test the file creation code on a couple rows.
I hope you can see advantages of this stepped approach, partcularly if your VBA is weak. Best of luck.

How do I trap new row adds in a list?

I want to execute an VBA event handler in an Excel 10 worksheet whenever the user adds a new row into a list (the kind of lists that Worksheet.ListObjects() returns instances of) on that worksheet, for example by entering data under the last row of the list (this expands the list by adding a new row to the list).
How do I do that? Among other things, I want to set defaults for specific cells of the new row.
My current idea is to handle Worksheet_Change, and check if the Target parameter is within the .Range of the ListObject I am interested in.
However, how would I find out if the user is creating a new row with his/her cell change, and differentiate that from edits of existing cells in the list?
I probably am just a little bit stupid here. I´d expect there would be a list event I could trap, but I cannot find any.
I think you are right, there are no Events for ListObject's. Using Worksheet_Change seems the right way to go. To detect New Row vs Existing Row edit you will need to roll you own method.
I would suggest tracking the number of rows in the ListOjects in order to detect when they change. In order to do this, try adding a hidden named range for each ListOject to hold the current number of rows. Populate them on file open, and test them on Worksheet_Change.
This will add or update hidden named ranges on file open (add to Workbook module)
Private Sub Workbook_Open()
Dim oList As ListObject
Dim sh As Worksheet
Dim nm As Name
Dim strName As String
For Each sh In Me.Worksheets
For Each oList In sh.ListObjects
'oList.ListRows.Count
strName = oList.Name & "Rows"
Set nm = Nothing
On Error Resume Next
Set nm = Me.Names(strName)
On Error GoTo 0
If nm Is Nothing Then
Set nm = Me.Names.Add(strName, CStr(oList.ListRows.Count))
Else
nm.RefersTo = CStr(oList.ListRows.Count)
End If
nm.Visible = False
Next oList, sh
End Sub
This will detect what type of change was made. I've made it a WorkBook level event, so only one is needed for all sheets. (add to Workbook module)
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim oList As ListObject
Dim nm As Name
Dim strName As String
For Each oList In sh.ListObjects
strName = oList.Name & "Rows"
If Not Application.Intersect(Target, oList.DataBodyRange) Is Nothing Then
Set nm = Nothing
On Error Resume Next
Set nm = Me.Names(strName)
On Error GoTo 0
If nm Is Nothing Then
Set nm = Me.Names.Add(strName, CStr(oList.ListRows.Count))
nm.Visible = False
End If
If oList.ListRows.Count <> Val(Replace(nm.Value, "=", "")) Then
nm.RefersTo = CStr(oList.ListRows.Count)
MsgBox "List " & oList.Name & " changed" & vbCrLf & "New Line"
Else
MsgBox "List " & oList.Name & " changed" & vbCrLf & "Existing Line"
End If
End If
Next
End Sub
Note: this does not handle the case where the name of an existing ListObject is changed. This is left as an exercise for the reader

Resources