Hi Trying to get some help to see why this is not working in a Macro that I have setup. The area where the debugger causes an issue is at the 2nd Selection.Formula area.
Sub PrintAllonges()
'
' PrintAllonges Macro
'
' Keyboard Shortcut: Ctrl+Shift+Y
'
Dim pdfName As String, FullName As String, Path As String, lRow As Long
Set oFSO = CreateObject("Scripting.FileSystemObject")
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
' Create Desktop Folder if not exists
If oFSO.FolderExists(Path & "\Allonges") Then
Else
MkDir Path & "\Allonges"
End If
'Turn off Screen Update
Sheets("MissingAllonges").Select
lRow = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox (lRow)
Sheets("AllongeTemplate").Select
Application.ScreenUpdating = False
For i = 2 To lRow
Range("G6").Select
Selection.Formula = "=MissingAllonges!I" & i
Range("E11").Select
Selection.Formula = _
"=TEXT(MONTH(MissingAllonges!D" & i & "),""mmmm"")&"" ""&DAY(MissingAllonges!D" & i & ")&"", ""&YEAR(MissingAllonges!D" & i & ")"""
pdfName = Sheets("AllongeTemplate").Range("H7").Value & " - " & Sheets("AllongeTemplate").Range("G6").Value & " Allonge"
FullName = Path & "\Allonges\" & pdfName & ".pdf"
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FullName, OpenAfterPublish:=False
Next i
Application.ScreenUpdating = True
End Sub
I put this in and got to work for other formulas where I am updating the loop but I can't get this to work and getting an error on syntax.
You have extra quotation marks at the end of the formula.
The corrected formula would be:
.Formula = "=TEXT(MONTH(MissingAllonges!D" & i & "),""mmmm"")&"" ""&DAY(MissingAllonges!D" & i & ")&"", ""&YEAR(MissingAllonges!D" & i & ")"
But I agree with #BigBen that the formula could be simplified, ie:
.Formula = "=TEXT(MissingAllonges!D" & i & ", ""mmmm d, yyyy"")"
Related
I am searching for a way to to count rows in a Table in a closed Workbook WITHOUT opening the source file, either a formula or macro. I have the following code snippet that does this for a range, but it does not work for a table.
Dim FName1 As String
' Path to Family Mapping.xlsx
FName1 = "\\ent.acme.com\IMI\[Family Mapping.xlsx]"
'get row count of closed workbook [Family Mapping.xlsx] Worksheet "BMS-DES-POBA"
Const ShName1 As String = "BMS-DES-POBA"
Const ColNo1 As Integer = 1
Dim ShNew1 As Worksheet
Dim LastRow5 As Long
Dim LastRow6 As Long
Debug.Print FName1
Application.DisplayAlerts = False
Set ShNew1 = Worksheets.Add
With ShNew1.Range("A1")
.FormulaR1C1 = "=COUNTA('" & FName1 & ShName1 & "'!C" & ColNo1 & ")"
LastRow5 = .Value
End With
ShNew1.Delete
Application.DisplayAlerts = True
Debug.Print Trim(LastRow5) + 1 'add one row to count to account for Header row
I've tried the following formulas, but nothing yet seems to work:
.FormulaR1C1 = "=COUNTA('" & FName1 & ShName2 & "'!C" & ColNo12 & ")"
.FormulaR1C1 = "=ROWS('" & FName1 & ShName2 & "'!Table_Query[#Data])"
The COUNTA formula returns 1,048,576 rows, which is the entire length of the spread sheet. The ROWS formula returns #REF when the source file with the table is closed.
Any assistance will be much appreciated.
The only reason it wasnt working for you is :
A. The Path name of the closed file . Try changing those workbook extentions to .xlsm , and refering to them in full. And
B. ShNew1.Delete
I'm trying it now on my computer and its working. Im well chuffed.
Get Rid of ShNew1.Delete. Your CountA works as it supposed to on a closed .xlsm file. And Just put the whole path.
.. "C:\Users\User\Documents\... " etc . Or whatever it is for your document and its location.
I should have asked first if renaming your closed files to xlsm and then running as shown, would be acceptable workaround for now.
I know you can mass-rename including the extentions, while they are closed. So if your happy with renaming your files .xlsm, deleting ShNew1.Delete and placing the whole path in Fname1, then it will return the correct values for you even when closed.
Sub main()
Dim FName1 As String
' Path to Family Mapping.xlsx
FName1 = "C:\Users\User\Documents\[MyFileName.xlsm]"
'get row count of closed workbook [Family Mapping.xlsx] Worksheet "BMS-DES-POBA"
Const ShName1 As String = "Sheet1"
Const ColNo1 As Integer = 1
Dim ShNew1 As Worksheet
Dim LastRow5 As Long
Dim LastRow6 As Long
Debug.Print FName1
Application.DisplayAlerts = False
Set ShNew1 = Worksheets.Add
With ShNew1.Range("A1")
'.FormulaR1C1 = "=COUNTa('" & FName1 & ShName1 & "'!C" & ColNo1 & ")"
'.FormulaR1C1 = "=COUNTif('" & FName1 & ShName1 & "'!C" & ColNo1 & "," & Chr(34) & "*" & Chr(34) & ")"
'.FormulaR1C1 = "=COUNTif('" & FName1 & ShName1 & "'!C" & ColNo1 & "," & Chr(34) & "*" & Chr(34) & ")"
''With ShNew1.Range("A2")
.FormulaR1C1 = "=COUNTA('" & FName1 & ShName1 & "'!C" & ColNo1 & ")"
LastRow5 = .Value
End With
'ShNew1.Delete
Application.DisplayAlerts = True
Debug.Print Trim(LastRow5) + 1
End Sub
I'm working on macro for MacBook for separating codes that we paste in file.
After running codes should show up in a folder on my desktop called Tour Codes.
However, file is not getting saved and macro shows error.
I've tried multiple adjustments and changing location of file but the problem remains.
I would appreciate any suggestions.
Sub create_files()
Application.ScreenUpdating = False
Dim iName, iPath
iName = GetUserNameMac
'Get Path and Workbook Name
'iPath = ActiveWorkbook.Path
iPath = "Macintosh HD:Users:" & iName & ":Desktop:Tour Codes"
Sheets("Data").Select
...
'create files
Dim r1, ddate, gate, id, cap, firstrow, rowcount, newcode
r1 = 2
firstrow = 2
...
Application.DisplayAlerts = False
'save file
ChDir "Macintosh HD:Users:" & iName & ":Desktop:Tour Codes"
ActiveWorkbook.SaveAs Filename:= _
iPath & ":" & id & "_" & Format(ddate, "yyyy-mm-dd") & "_" & gate & "_" & firstrow & ".csv", _
FileFormat:=xlCSV, CreateBackup:=False
'ActiveWorkbook.SaveAs iPath & ":" & merchWk
'ActiveWorkbook.SaveAs iPath & "/" & merchWk
Windows("Gate 1 codes macro.xlsm").Activate
'copy rows to file
'Rows(firstrow & ":" & firstrow + rowcount - 2).Select
Range(Cells(firstrow, 1), Cells(firstrow + rowcount - 2, 1)).Select
Selection.Copy
Windows(id & "_" & Format(ddate, "yyyy-mm-dd") & "_" & gate & "_" & firstrow & ".csv").Activate
'Cells(2, 1).Select
Cells(1, 1).Select
ActiveSheet.Paste
'Columns("A:E").EntireColumn.AutoFit
Columns("A:A").EntireColumn.AutoFit
'save file
Cells(1, 1).Select
ActiveWorkbook.Save
ActiveWindow.Close
Application.DisplayAlerts = True
Windows("Gate 1 codes macro.xlsm").Activate
firstrow = r1 - 1
r1 = firstrow
Loop Until r1 > lastrow
End Sub
Function GetUserNameMac() As String
Dim sMyScript As String
sMyScript = "set userName to short user name of (system info)" & vbNewLine & "return userName"
GetUserNameMac = MacScript(sMyScript)
End Function
VBA errors out on these lines:
I have some vArrays which are not clearing out. The purspose of the macro is to work on a raw data tab which has 30+ tabs, each tab holding information for a specific office, 001-New York, etc. The macro is supposed to select x number of tabs (based on a reference file), copy them and save them into a new workbook. The problem is that instead of copying and saving from the raw data file it save the reference file instead. A For...Next loop is used to determine which tabs/offices to select & copy from the raw data file. The varrays are inside the loop and contain the names of the offices. When the code encounters the vArray the varray values are not clearing out when the loop circles back around.
Example:
'For 1' reference a cell with value of "8" so it populates 8 different vArray values (offices in this case). 'For 2' has a reference number of 5 and is supposed to populate 5 vArray values. It does this correctly as I can see the 5 new values in the locals window under vArray (1) thru vArray (5), however, vArray 6 thru 8 are showing values of the previous loop instead of 'Empty'. The vArray values are not clearing out when the macro loops.
sMasterListWBName is the reference file which tells the macro which tabs to copy from the raw data file and where to move the newly created workbook. The sub is also copying, saving, and distributing the reference file instead of the raw data file for some iterations of the loop (secondary issue--I will try to refrain from splitting the thread topic).
Thanks in advance to anyone who tries to answer this question.
Option Explicit
Dim iYear As Integer, iMonth As Integer, iVer As Integer, icount As Integer, iCount2 As Integer
Dim iLetter As String, iReport As String
Dim sMonth As String, sDate As String, sVer As String, sAnswer As String
Dim sFolderName As String, sManagerInitials As String
Dim iManagerNumber As Integer, iManagerStart As Integer, iTabNumber As Integer, iTabStart As Integer
Dim sMasterListWBName As String, sConsolidatedWBName As String, sExists As String
Dim oSheet As Object, oDistList As Object
Dim vArray(300) As Variant
Dim wbDistList As Workbook
Dim wsAgentListSheet As Worksheet, wsMain As Worksheet
Dim rCell As Range, rCell2 As Range, rCellTotal As Range
Public sFINorAgent As String
Sub Agent_Distribute()
On Error Resume Next
iYear = frm_fin_rep_main_distribute.txt_year
iMonth = frm_fin_rep_main_distribute.txt_month
iVer = frm_fin_rep_main_distribute.txt_version
sMonth = Right("0" & iMonth, 2)
sDate = iYear & "." & sMonth
sVer = "V" & iVer
sAnswer = MsgBox("Is the following information correct?" & vbNewLine & vbNewLine & _
"Report - " & frm_fin_rep_main.sLetter & vbNewLine & _
"Year - " & iYear & vbNewLine & _
"Month - " & sMonth & vbNewLine & _
"Name - " & frm_fin_rep_main.sReport & vbNewLine & _
"Version - " & sVer, vbYesNo + vbInformation, "Please verify...")
If sAnswer <> vbYes Then
Exit Sub
End If
Unload frm_fin_rep_main_distribute
frm_agent.Hide
Form_Progress
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
sConsolidatedWBName = ActiveWorkbook.Name
sMasterListWBName = "Dist Master List Final.xls"
If Not IsFileOpen(sMasterListWBName) Then
Workbooks.Open FileName:= _
"W:\Addins\01 GL - Distribution\" & sMasterListWBName, Password:="password"
Workbooks(sConsolidatedWBName).Activate
End If
Set oDistList = Workbooks(sMasterListWBName).Worksheets("Agent")
With oDistList
iManagerNumber = .Range("ManNumber2") 'range value = 66
For iManagerStart = 2 To iManagerNumber '2 to 66
If .Range("A" & iManagerStart) = "x" Then
iTabNumber = .Range("E" & iManagerStart) 'E2 to E66
sFolderName = .Range("F" & iManagerStart) 'F2 to F66
sManagerInitials = .Range("G" & iManagerStart) 'G2 to G66
For iTabStart = 1 To iTabNumber
vArray(iTabStart) = .Range("G" & iManagerStart).Offset(0, iTabStart)
Next iTabStart
If iTabNumber = 1 Then
Sheets(vArray(1)).Select
Else
Sheets(vArray(1)).Select
For iTabStart = 2 To iTabNumber
Sheets(vArray(iTabStart)).Select False
Next iTabStart
End If
ActiveWindow.SelectedSheets.Copy
' *** the following code is optional, remove preceding apostrophes from the following four lines to enable password protection ***
'For Each oSheet In ActiveWorkbook.Sheets
'oSheet.Protect "password"
'oSheet.EnableSelection = xlNoSelection
'Next
ActiveWorkbook.SaveAs FileName:= _
"W:\Financials\" & iYear & "\" & sDate & "\Report to Distribute Electronically\Department Reports\" _
& sFolderName & "\Current Year Financials" & "\" & "Y" & ") " & iYear & "-" & sMonth & " Agent Report Card " & sVer & " - " & sManagerInitials & ".xls"
ActiveWorkbook.Close
End If
iPercent = iManagerStart / iManagerNumber * 95
Task_Progress (iPercent)
Next iManagerStart
End With
Workbooks(sMasterListWBName).Close False
Task_Progress (100)
Unload frm_progress
Set oDistList = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Message_Done
frm_agent.Show (vbModeless)
End Sub
I fixed it. I just added "Workbooks(sWbName).activate" at the end of the loop to make sure the focus is back on the raw data file. Now all files are saving in the correct format and location. Case closed unless someone has anything else to add. Maybe someone knows the reason the macro was losing sight of its active sheet (saving reference file instead of raw data file). Thank you.
I'm trying to copy a lot of workbooks into a summary workbook, I've gotten the below code to do the job so far.
Option Explicit
Const FOLDER_PATH = "Folderpath\" 'REMEMBER END BACKSLASH
Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row
rowTarget = Sheets("Status").Cells(Rows.Count, "AK").End(xlUp).Row + 1
'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If
'reset application settings in event of error
'On Error GoTo errHandler
'Application.ScreenUpdating = False
'set up the target worksheet
Set wsTarget = Sheets("Status")
'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""
'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets("Side 1-Forside") 'EDIT IF NECESSARY
'import the data
With wsTarget
.Activate
wsSource.Range("C14").Copy
.Range("A" & rowTarget).Select
ActiveSheet.Paste Link:=True
wsSource.Range("C15").Copy
.Range("B" & rowTarget).Select
ActiveSheet.Paste Link:=True
wsSource.Range("C13").Copy
.Range("C" & rowTarget).Select
ActiveSheet.Paste Link:=True
wsSource.Range("I11").Copy
.Range("J" & rowTarget).Select
ActiveSheet.Paste Link:=True
wsSource.Range("I10").Copy
.Range("K" & rowTarget).Select
ActiveSheet.Paste Link:=True
wsSource.Range("C40").Copy
.Range("L" & rowTarget).Select
ActiveSheet.Paste Link:=True
wsSource.Range("E40").Copy
.Range("M" & rowTarget).Select
ActiveSheet.Paste Link:=True
wsSource.Range("I9").Copy
.Range("H" & rowTarget).Select
ActiveSheet.Paste Link:=True
'optional source filename in the last column
.Range("AK" & rowTarget).Value = sFile
End With
'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + 1
sFile = Dir()
Loop
'errHandler:
'On Error Resume Next
'Application.ScreenUpdating = True
'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
End Sub
Private Function FileFolderExists(strPath As String) As Boolean
If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function
However is it possible to grab the data as a link instead of a "dead" value? So if it gets changed in one of the many workbooks, I just have to refresh the summary workbook?
Bonusquestion: Is it possible to check for duplicates in this bit: .Range("AK" & rowTarget).Value = sFile and only add if the values isn't there already and the new values should add from the last empty row below row 5?
You could copy the source range and then use Special Paste › Paste Link in the destination workbook. It pastes a formula linking to the source workbooks copied range.
This short YouTube video should illustrate it best.
You could also do that with VBA if necessary e.g:
wsSource.Range("C14").Copy
.Range("A" & rowTarget).Select
ActiveSheet.Paste Link:=True
It seems like we need to .Select first and use ActiveSheet.Paste otherwise the link pasting fails, even if that looks like a bad practice, but the below direct referencing the range won't work!
wsSource.Range("C14").Copy
.Range("A" & rowTarget).Paste Link:=True 'fails with error 438
But because you are linking the values now with a formula you probably need to do that only once and therefore don't need the VBA solution anymore, because it is easier to do it once by hand.
Note:
be aware that these workbooks are linked by a formula then. If you move the source workbook into another location the link will break (if the destination workbook is not within the same location and copied as well). This comes with all the downsides of linked workbooks.
//edit
With wsTarget
.Activate
.Range("A" & rowTarget).Select
wsSource.Range("C14").Copy
.Paste Link:=True
.Activate
.Range("B" & rowTarget).Select
wsSource.Range("C15").Copy
.Paste Link:=True
Alternative solution to the one suggested by Peh, both work, though the one below is not as flexible but hardcoded instead. Thought I would share.
Option Explicit
Const FOLDER_PATH = "Folderpath\" 'REMEMBER END BACKSLASH
Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row
rowTarget = Sheets("Status").Cells(Rows.Count, "AK").End(xlUp).Row + 1
'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If
'reset application settings in event of error
'On Error GoTo errHandler
'Application.ScreenUpdating = False
'set up the target worksheet
Set wsTarget = Sheets("Status")
'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""
'import the data
With wsTarget
'optional source filename in the last column
.Range("AK" & rowTarget).Value = sFile
.Range("A" & rowTarget).Value = "=" & "'" & FOLDER_PATH & "[" & .Range("AK" & rowTarget).Value & "]" & "Side 1-Forside" & "'" & "!$C$14"
.Range("B" & rowTarget).Value = "=" & "'" & FOLDER_PATH & "[" & .Range("AK" & rowTarget).Value & "]" & "Side 1-Forside" & "'" & "!$C$15"
.Range("C" & rowTarget).Value = "=" & "'" & FOLDER_PATH & "[" & .Range("AK" & rowTarget).Value & "]" & "Side 1-Forside" & "'" & "!$C$13"
.Range("J" & rowTarget).Value = "=" & "'" & FOLDER_PATH & "[" & .Range("AK" & rowTarget).Value & "]" & "Side 1-Forside" & "'" & "!$I$11"
.Range("K" & rowTarget).Value = "=" & "'" & FOLDER_PATH & "[" & .Range("AK" & rowTarget).Value & "]" & "Side 1-Forside" & "'" & "!$I$10"
.Range("L" & rowTarget).Value = "=" & "'" & FOLDER_PATH & "[" & .Range("AK" & rowTarget).Value & "]" & "Side 1-Forside" & "'" & "!$C$40"
.Range("M" & rowTarget).Value = "=" & "'" & FOLDER_PATH & "[" & .Range("AK" & rowTarget).Value & "]" & "Side 1-Forside" & "'" & "!$E$40"
.Range("H" & rowTarget).Value = "=" & "'" & FOLDER_PATH & "[" & .Range("AK" & rowTarget).Value & "]" & "Side 1-Forside" & "'" & "!$I$9"
End With
'close the source workbook, increment the output row and get the next file
rowTarget = rowTarget + 1
sFile = Dir()
Loop
'errHandler:
'On Error Resume Next
'Application.ScreenUpdating = True
'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
End Sub
Private Function FileFolderExists(strPath As String) As Boolean
If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function
Try this AddIn. It will do exactly what you want.
https://www.rondebruin.nl/win/addins/rdbmerge.htm
How do you properly construct a VLOOKUP statement in Excel VBA when using the ExecuteExcel4Macro function in VBA?
I have a function that successfully looks up a value in another excel workbook without opening it using ExecuteExcel4Macro, but when I attempt to change the statement to a VLOOKUP statement I get a Run-time error 1004:
The function:
Public Function fGetValueTest(sFilePath, sFileName, sSourceSheet, sSourceCell, vVal, Col)
'Returns the value of a cell from a closed file [BD]
'Declaring variables [BD]
Dim sStringMacro As String
Dim externalValue As Variant
'Setting variables [BD]
externalValue = ExecuteExcel4Macro("'" & sFilePath & "[" & sFileName & "]" & sSourceSheet & "'!" & _
Range("A1").Range(sSourceCell).Address(, , xlR1C1))
'Exception error on file not found [BD]
If Dir(sFilePath & sFileName) = "" Then
fGetValueTest = "File Not Found!"
Exit Function
End If
'If value of source cell is N/A [BD]:
If Application.IsNA(externalValue) Then
'Skip and move on [BD]
fGetValueTest = "0"
ElseIf IsError(externalValue) Then
MsgBox "Error - Check fGetValue Function"
Else
'Creating macro variable [BD]
sStringMacro = "'" & sFilePath & "[" & sFileName & "]" & sSourceSheet & "'!" & _
Range("A1").Range(sSourceCell).Address(, , xlR1C1)
fGetValueTest = ExecuteExcel4Macro("Vlookup(" & vVal & "," & sStringMacro & "," & Col & ",0)")
End If
End Function
And it's usage in the subroutine:
Sub TestGetValue()
Dim sFileName As String
Dim sFilePath As String
Dim sSourceSheet As String
Dim sSourceCell As String
Dim sDestinationCell As String
Dim sDestinationSheet As String
Dim vVal As String
Dim Col As String
sFileName = "0306-0312 Margin Master.xlsx"
sFilePath = "\\store\GroupDrives\Pricing\_Deli_\Deli Fresh Shift\Margin Master\"
sSourceSheet = "Bakery"
sDestinationSheet = "TestSheet"
sSourceCell = "G10"
sDestinationCell = "G10"
vVal = "A10"
Col = 3
ThisWorkbook.Worksheets(sDestinationSheet).Range(sDestinationCell) = fGetValueTest(sFilePath, sFileName, sSourceSheet, sSourceCell, vVal, Col)
End Sub
I don't see any errors in how the VLOOKUP statement is constructed, does ExecuteExcel4Macro require a different type of statement or is there something else going on here?
Any help would be greatly appreciated, and if anyone happens to know if there is a manual for ExecuteExcel4Macro or any documentation of any real value that would also be helpful!
This is a possibility if it can be adopted:
Function:
Public Function GetVlookup(path, file, sheet, ref, Col, vVal)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetVlookup = "File Not Found"
Exit Function
End If
If IsNumeric(vVal) Then
vVal = CDbl(vVal)
Else
vVal = Chr(34) & vVal & Chr(34)
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Address(, , xlR1C1)
' Execute an XLM macro
GetVlookup = ExecuteExcel4Macro("Vlookup(" & vVal & "," _
& arg & "," & Col & ",0)")
End Function
Subroutine:
Sub TestThingSub()
Dim Varr As Variant
Varr = GetVlookup("\\store\GroupDrives\Pricing\_Deli_\Deli Fresh Shift\Margin Master\", "0306-0312 Margin Master2.xlsx", "Sheet2", "A1:B26", 2, "HORSE")
MsgBox Varr
End Sub