Oracle SQL case when missing right parantheses - sql
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
Related
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
Excel Function to Access Function
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.
How to merge a number of loops into one in a VBA program?
I am fairly inexperienced with VBA, and I can't figure out how to make this loop. I set up 4 separate statements and it works this way, but I want to make this one statement. i = 1 Do Until i > combos Range(Cells(i, 10), Cells(i + Defrepeat - 1, 10)) = Range(Cells(3, 4), Cells(3, 4)) i = i + TErepeat Loop w = 4 Do Until w > combos Range(Cells(w, 10), Cells(w + Defrepeat - 1, 10)) = Range(Cells(4, 4), Cells(4, 4)) w = w + TErepeat Loop p = 7 Do Until p > combos Range(Cells(p, 10), Cells(p + Defrepeat - 1, 10)) = Range(Cells(5, 4), Cells(5, 4)) p = p + TErepeat Loop k = 10 Do Until k > combos Range(Cells(k, 10), Cells(k + Defrepeat - 1, 10)) = Range(Cells(6, 4), Cells(6, 4)) k = k + TErepeat Loop
Dim c As Range, i As Long, n As Long Set c = Cells(3, 4) For n = 1 To 10 Step 3 i = n Do Until i > combos Range(Cells(i, 10), Cells(i + Defrepeat - 1, 10)) = c.Value i = i + TErepeat Loop Set c = c.Offset(1, 0) Next n
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()