Excel Function to Access Function - vba

I created UPC check-digit function in excel which is working perfectly fine but i am now in need of creating same thing in MS Access.
here is the code:
Public Function CHECKDIGIT(UPC As String) As String
If Len(UPC) = 8 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1)), -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1)))
ElseIf Len(UPC) = 12 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1)), -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1)))
ElseIf Len(UPC) = 13 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1)) + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1)) * 3, -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1)) + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1)) * 3)
ElseIf Len(UPC) = 14 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1)), -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1)))
ElseIf Len(UPC) = 17 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1), Mid(UPC, 15, 1)) + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1), Mid(UPC, 14, 1), Mid(UPC, 16, 1)) * 3, -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1), Mid(UPC, 15, 1)) + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1), Mid(UPC, 14, 1), Mid(UPC, 16, 1)) * 3)
ElseIf Len(UPC) = 18 Then
CHECKDIGIT = WorksheetFunction.RoundUp(WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1), Mid(UPC, 15, 1), Mid(UPC, 17, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1), Mid(UPC, 14, 1), Mid(UPC, 16, 1)), -1) - (WorksheetFunction.Sum(Mid(UPC, 1, 1), Mid(UPC, 3, 1), Mid(UPC, 5, 1), Mid(UPC, 7, 1), Mid(UPC, 9, 1), Mid(UPC, 11, 1), Mid(UPC, 13, 1), Mid(UPC, 15, 1), Mid(UPC, 17, 1)) * 3 + WorksheetFunction.Sum(Mid(UPC, 2, 1), Mid(UPC, 4, 1), Mid(UPC, 6, 1), Mid(UPC, 8, 1), Mid(UPC, 10, 1), Mid(UPC, 12, 1), Mid(UPC, 14, 1), Mid(UPC, 16, 1)))
ElseIf Len(UPC) <> 8 Or Len(UPC) <> 12 Or Len(UPC) <> 13 Or Len(UPC) <> 14 Or Len(UPC) <> 17 Or Len(UPC) <> 18 Then
CHECKDIGIT = "MISSING DIGITS"
End If
End Function
Is there any easy way to convert this to MS Access?
To my knowledge not all formulas will transfer directly to access so I image I will need to build custom function in Access too.
Any idea how to go with this?
Thanks,
Slav


The following code should work equally well in Excel and Access:
Public Function CHECKDIGIT(UPC As String) As String
Dim n As Integer
Dim i As Integer
Select Case Len(UPC)
Case 8, 12, 13, 14, 17, 18
n = 0
For i = 1 To Len(UPC) - 1
If ((Len(UPC) - i) Mod 2) = 1 Then
n = n + CInt(Mid(UPC, i, 1)) * 3
Else
n = n + CInt(Mid(UPC, i, 1))
End If
Next
CHECKDIGIT = CStr(Int(n / 10 + 0.99) * 10 - n)
Case Else
CHECKDIGIT = "MISSING DIGITS"
End Select
End Function


Thank you for the code YowE3K. I think there is something missing in that code. When i run it against results i get using my code It fails.
UPC CHCKDIGIT NEW CHKDIGIT
018371009355 5 5
00018371009355 5 5
7501206634004 4 10
00018371019354 4 14
018371019354 4 14
Also by using function i just found out that i cant use the function as part of data entry validation. I will have to use formula using what Comintern suggested above.
Thank you both guys for helping with this.

Related

Oracle SQL case when missing right parantheses

I have this case when statement as subquery somewhere in a query that I need to fix and I admit I have no idea what it does, but it gives me missing right parentheses, can someone help me to fix the syntax?
(SELECT *
FROM (case when length(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 2 THEN
(SELECT NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 3 THEN
(SELECT NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 4 THEN
(SELECT NULL,
NULL,
NULL,
NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 5 THEN
(SELECT NULL,
NULL,
NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 6 THEN
(SELECT
NULL,
NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 5, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 7 THEN
(SELECT NULL,
NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 6, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 5, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 8 THEN
(SELECT NULL,
NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 7, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 6, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 5, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 9 THEN
(SELECT NULL,
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 8, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 7, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 6, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 5, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
when LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) = 10 THEN
(SELECT SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 9, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 8, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 7, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 6, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 5, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 4, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 3, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 2, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER) - 1, 1),
SUBSTR(TO_CHAR(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), LENGTH(nationalNumber.NATIONAL_IDENTIFIER_NUMBER), 1))
ELSE
(SELECT NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL)
END) NID1

You have at least 2 problems:
You cannot have a SELECT statement without a FROM clause.
You cannot have CASE WHEN ... (SELECT multiple, columns ...) as a CASE expression must return a single value.
You probably do not need the CASE expression and can use:
SELECT SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -10, 1) AS chr1,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -9, 1) AS chr2,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -8, 1) AS chr3,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -7, 1) AS chr4,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -6, 1) AS chr5,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -5, 1) AS chr6,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -4, 1) AS chr7,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -3, 1) AS chr8,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -2, 1) AS chr9,
SUBSTR(NATIONAL_IDENTIFIER_NUMBER, -1, 1) AS chr10
FROM table_name
WHERE LENGTH(NATIONAL_IDENTIFIER_NUMBER) BETWEEN 2 AND 10
Which, for the sample data:
CREATE TABLE table_name (NATIONAL_IDENTIFIER_NUMBER) AS
SELECT 'a' FROM DUAL UNION ALL
SELECT 'ab' FROM DUAL UNION ALL
SELECT 'abc' FROM DUAL UNION ALL
SELECT 'abcd' FROM DUAL UNION ALL
SELECT 'abcde' FROM DUAL UNION ALL
SELECT 'abcdef' FROM DUAL UNION ALL
SELECT 'abcdefg' FROM DUAL UNION ALL
SELECT 'abcdefgh' FROM DUAL UNION ALL
SELECT 'abcdefghi' FROM DUAL UNION ALL
SELECT 'abcdefghij' FROM DUAL UNION ALL
SELECT 'abcdefghijk' FROM DUAL UNION ALL
SELECT 'abcdefghijki' FROM DUAL
Outputs:
CHR1
CHR2
CHR3
CHR4
CHR5
CHR6
CHR7
CHR8
CHR9
CHR10
null
null
null
null
null
null
null
null
a
b
null
null
null
null
null
null
null
a
b
c
null
null
null
null
null
null
a
b
c
d
null
null
null
null
null
a
b
c
d
e
null
null
null
null
a
b
c
d
e
f
null
null
null
a
b
c
d
e
f
g
null
null
a
b
c
d
e
f
g
h
null
a
b
c
d
e
f
g
h
i
a
b
c
d
e
f
g
h
i
j
fiddle

application-defined or object-defined error Ubound

there I have an excel VBA code that retrieves its records from an external file by month and set it according to the column heading.
However, i have an error in of application-defined or object-defined error in of the line .Range("A6").Resize(n, 23) = b
does anyone know why
code:
Sub zz()
Dim arr, c, b(), n&
Application.ScreenUpdating = False
Worksheets("Sheet2").Range("A6").AutoFilter
Workbooks.Open "C:\Users\sophia.tan\Desktop\MasterPlanData.xlsx", 0, 1
arr = Sheets("Excel").UsedRange
ActiveWorkbook.Close 0
c = Array(0, 2, 13, 14, 7, 8, 11, 1, 9, 10, 16, 17, 20, 22, 15, 30, 27, 28, 29, 3, 4, 30)
d = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23)
ReDim b(1 To UBound(arr), 1 To 23)
For i = 2 To UBound(arr)
If arr(i, 12) >= DateSerial(Year:=2017, Month:=11, Day:=1) And arr(i, 12) <= DateSerial(Year:=2017, Month:=11, Day:=31) Then
n = n + 1
For j = 1 To UBound(c)
b(n, d(j)) = arr(i, c(j))
Next
End If
Next
With Worksheets("Sheet2")
.Range("A6:T" & Rows.Count).CurrentRegion.AutoFilter field:=1, Criteria1:="<>OFM"
.Range("A6:T" & Rows.Count).CurrentRegion.SpecialCells(xlCellTypeVisible).AutoFilter field:=13, Criteria1:="<>Collar & Cuff"
.Range("A6:T" & Rows.Count).CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Range("A6").Resize(n, 23) = b
.Range("A6").CurrentRegion.Sort key1:=Range("G6"), order1:=xlAscending, Header:=xlYes
.Range("A6").Select
End With
Application.ScreenUpdating = 1
End Sub

Your determination on n is subjective to the If statement. However, any unfilled values in the 'rows' of b will be vbnullstrings and will produce truly blank cells.
.Range("A6").Resize(ubound(b, 1), ubound(b, 2)) = b
Alternately,
For i = 2 To UBound(arr)
If arr(i, 12) >= DateSerial(Year:=2017, Month:=11, Day:=1) And arr(i, 12) <= DateSerial(Year:=2017, Month:=11, Day:=31) Then
n = n + 1
For j = 1 To UBound(c)
b(n, d(j)) = arr(i, c(j))
Next
End If
Next
b = application.transpose(b)
redim preserve b(lbound(b, 1) to ubound(b, 1), lbound(b, 2) to n)
b = application.transpose(b)
.Range("A6").Resize(n, 23) = b
You can only adjust the last rank of an array with ReDim when using the preserve parameter.

Try
.Range("A6").Resize(n, 23).Value = b

Merge Text Files From Folder VBA

I've been using the below code for awhile but have noticed that it is dropping off leading 0's.
I've tried changing the code to .OpenText and get error
"Expected Function or variable".
Files that are loaded are .csv files converted to .txt before opened using a batch script.
Sub ExcelFileMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("H:\Reports\ahs\ProductDatabase\CV3 Tools\CV3 Product Merger\CV3 Files")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
'This is what I have tried changing to .OpenText and get returned error "Expected Function or variable"
Set bookList = Workbooks.Open(everyObj)
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:AET" & Range("A2600").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False
bookList.Close
Here is the code I got after recording the macro. Now I'm trying to figure out how to mesh the 2.
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;R:\ahs\ProductDatabase\CV3 Tools\CV3 Product Merger\CV3 Files\product_export1.txt" _
, Destination:=Range("$A$1"))
.CommandType = 0
.Name = "product_export1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

OK, here's a mesh of your two, slightly adjusted:
Sub ExcelFileMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim con As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set dirObj = mergeObj.getfolder("H:\Reports\ahs\ProductDatabase\CV3 Tools\CV3 Product Merger\CV3 Files")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Add
con = "TEXT;" & everyObj
With bookList.Sheets(1).QueryTables.Add(Connection:= _
con, Destination:=Range("$A$1"))
.Name = "product_export1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:AET" & Range("A2600").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False
bookList.SaveAs "GiveItAPathAndFilenameHere"
bookList.Close
Next
End Sub

Convert a Hex number to a GUID with dashes

I have several hundred Hex numbers (32 char long) that were pulled from a sql db. I have them stored in an excel table and need to convert them to GUID with dashes. I have found an online converter, but it only does one at a time and this would be very time consuming (http://www.windowstricks.in/online-windows-guid-converter). Is there a way, either in Excel with VBA or Formulas or in SQL to convert these? It is not as simple as just adding the dashes into the correct places. I've tried that and it is not what I need to have happen. An example of the Hex and the converted dash separated GUID:
Hex
6F414B9DFB178945A3641E40BC2A4AAB
C58C415E215CEC4D9B5100532573D3FA
2B0BBF00A1403E41A333C805961CEA9F
GUID converted from the Hex above
48a6c53b-941c-46e2-9964-680754f71666
ea0ba3f4-4905-4d9c-9d83-76c57bdb060a
18cea3f7-e1d1-4609-a4bc-9bf6fec6a2d4
Any help you can give would be very appreciated.
Thanks

This function converts an hexadecimal String to a formatted GUID string:
Public Function ConvHexToGuid(hexa As String) As String
Dim guid As String * 36
Mid$(guid, 1) = Mid$(hexa, 7, 2)
Mid$(guid, 3) = Mid$(hexa, 5, 2)
Mid$(guid, 5) = Mid$(hexa, 3, 2)
Mid$(guid, 7) = Mid$(hexa, 1, 2)
Mid$(guid, 9) = "-"
Mid$(guid, 10) = Mid$(hexa, 11, 2)
Mid$(guid, 12) = Mid$(hexa, 9, 2)
Mid$(guid, 14) = "-"
Mid$(guid, 15) = Mid$(hexa, 15, 2)
Mid$(guid, 17) = Mid$(hexa, 13, 2)
Mid$(guid, 19) = "-"
Mid$(guid, 20) = Mid$(hexa, 17, 4)
Mid$(guid, 24) = "-"
Mid$(guid, 25) = Mid$(hexa, 21, 16)
ConvHexToGuid = guid
End Function

The GUID to HEX is transposed as follows:
0x00112233445566778899AABBCCDDEEFF
{33221100-5544-7766-8899-AABBCCDDEEFF}

I have found an answer. Thanks to #florent. I'm not sure why the GUID's came out differently and still worked the first time I was running this, but I have a solution. I did this using VBA code:
Sub CreateGUID()
Dim count, GUIDConverted As String
count = 2
Do While Range("F" & count).Value <> ""
Range("F" & count).Select
GUIDConverted = Range("F" & count).Value
GUIDConverted = ConvertHexToGUID(GUIDConverted)
Range("H" & count).Value = GUIDConverted
count = count + 1
Loop
End Sub
Public Function ConvertHexToGUID(hexa As String) As String
Dim guid As String * 36
Mid$(guid, 1) = Mid$(hexa, 7, 2)
Mid$(guid, 3) = Mid$(hexa, 5, 2)
Mid$(guid, 5) = Mid$(hexa, 3, 2)
Mid$(guid, 7) = Mid$(hexa, 1, 2)
Mid$(guid, 9) = "-"
Mid$(guid, 10) = Mid$(hexa, 11, 2)
Mid$(guid, 12) = Mid$(hexa, 9, 2)
Mid$(guid, 14) = "-"
Mid$(guid, 15) = Mid$(hexa, 15, 2)
Mid$(guid, 17) = Mid$(hexa, 13, 2)
Mid$(guid, 19) = "-"
Mid$(guid, 20) = Mid$(hexa, 17, 4)
Mid$(guid, 24) = "-"
Mid$(guid, 25) = Mid$(hexa, 21, 16)
ConvertHexToGUID = guid
End Function
This worked for all of the Hex numbers that I had.
Thanks to all those who took time to make a response they did all help as I was working on this.

Visual basic matrices rotation

I made a square using 2 1 by 4 matrices, however now I want to rotate it by 45 degrees.
This is the code for the square (which works fine):
Dim m(1, 4) As Single
Dim n(1, 4) As Single
Dim formGraphics As System.Drawing.Graphics = Me.CreateGraphics()
Dim myPen As New System.Drawing.Pen(System.Drawing.Color.Black)
formGraphics.DrawLine(myPen, m(1, 1), m(1, 2), n(1, 4), n(1, 3))
formGraphics.DrawLine(myPen, n(1, 1), n(1, 3), m(1, 4), m(1, 3))
formGraphics.DrawLine(myPen, n(1, 2), n(1, 4), m(1, 2), m(1, 1))
formGraphics.DrawLine(myPen, n(1, 3), n(1, 3), m(1, 3), m(1, 1))
myPen.Dispose()
formGraphics.Dispose()
However when I try and turn it by 45 degrees I just cannot seem to get it right and I have no idea what I'm doing wrong or how to fix it. Code so far:
Dim b(1, 4) As Single
Dim c(1, 4) As Single
Dim A(2, 2) As Single
Dim radians As Double
Dim degrees As Double
degrees = 45
radians = degrees * ((2 * PI) / 360)
A(1, 1) = Cos(radians)
A(1, 2) = -Sin(radians)
A(2, 1) = Sin(radians)
A(2, 2) = Cos(radians)
c(1, 1) = (A(1, 1) * m(1, 2)) + (A(1, 2) * n(1, 2))
c(1, 2) = (A(1, 1) * m(1, 3)) + (A(2, 2) * n(1, 3))
c(1, 3) = (A(1, 1) * m(1, 3)) + (A(2, 2) * n(1, 3))
c(1, 4) = (A(1, 1) * m(1, 2)) + (A(1, 2) * n(1, 2))
b(1, 1) = (A(2, 1) * m(1, 2)) + (A(2, 2) * n(1, 2))
b(1, 2) = (A(2, 1) * m(1, 3)) + (A(2, 2) * n(1, 3))
b(1, 3) = (A(2, 1) * m(1, 3)) + (A(2, 2) * n(1, 3))
b(1, 4) = (A(2, 1) * m(1, 4)) + (A(2, 2) * n(1, 4))
Dim formGraphics As System.Drawing.Graphics = Me.CreateGraphics()
Dim myPen As New System.Drawing.Pen(System.Drawing.Color.Black)
formGraphics.DrawLine(myPen, b(1, 3), b(1, 4), c(1, 4), c(1, 4))
formGraphics.DrawLine(myPen, c(1, 4), c(1, 2), b(1, 4), b(1, 4))
formGraphics.DrawLine(myPen, b(1, 1), c(1, 2), b(1, 4), b(1, 4))
formGraphics.DrawLine(myPen, c(1, 4), c(1, 1), b(1, 4), b(1, 2))
myPen.Dispose()
formGraphics.Dispose()