I'm trying to create a single PDF file containing a sheet for each tab which I have listed from cell J2 in my Control sheet but I keep getting a Subscript Out Of Range error.
When I record the action I see that it creates an array of sheet names which it then selects to export, so I have a For loop which goes through the list and creates an array which adds to itself until it reaches the end of the list - the aim being to create one long string which I then select as an array.
All appears to be good (the variable PDFArray displays a string of the tab names in what appears to be the correct format) but when I get to the line 'Worksheets(Array(PDFarray)).Select' then I get the error. I've made sure the sheet names contain no undesirable characters or spaces but still no joy. Any help would be very much appreciated. Thank you
Sub B_PDFs()
Dim PDFarray As String, PDFName as String, sht As String
Sheets("Control").Select
PLFile = ActiveWorkbook.Name
PDFLoc = Application.ActiveWorkbook.Path & "\"
PDFName = Range("A20")
PDFSheetCount = Range("J1").Offset(Rows.Count - 1, 0).End(xlUp).Row
'Loop through column J and create a string with each tab name to be exported
For x = 2 To PDFSheetCount Step 1
If x = PDFSheetCount Then
sht = """ " & "" & Cells(x, 10) & """ "
Else
sht = """" & "" & Cells(x, 10) & """" & ", "
End If
PDFarray = PDFarray & sht
Next x
'Create PDF from the array above
Worksheets(Array(PDFarray)).Select - this is where I get the error Subscript Out Of Range
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PFDLoc & PDFName, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False,
OpenAfterPublish:=False
Workbooks(PLFile).Activate
End Sub
I don't understand why MS makes NOT requiring variable declaration the default. Select Tools/Options/Editor and check Require Variable Declaration. This will place Option Explicit at the start of any new module. To correct this module, enter it manually at the beginning.
Doing so would have enabled you to find and correct a typo in your code.
You should also be avoiding Select, Selection and Activate. They rarely serve any purpose at all, and can cause multiple problems because they lull into avoiding explicit declarations of which workbook, worksheet, etc. you need. See How to avoid using Select in Excel VBA
However in using the ExportAsFixedFormat method to export selected worksheets, it seems Selection and ActiveSheet are required for it to work.
Array(str_variable) returns an array with a single entry that contains the entire string variable. It does not interpret the string variable so as to split it into separate elements.
So, rewriting your code somewhat (I will leave it to you to clean up the PDF document):
Option Explicit
Sub B_PDFs()
Dim PDFarray As Variant, PDFName As String, PLFile As String, PDFLoc As String
Dim wsControl As Worksheet
Dim WB As Workbook
'Consider wheter you want to use ThisWorkbook or a specific workbook
Set WB = ThisWorkbook
With WB
Set wsControl = .Worksheets("Control")
PLFile = .Name
PDFLoc = .Path & "\"
End With
With wsControl
PDFName = .Range("A20")
'create PDFarray
'This will be a 1-based 2D array starting at J1
'If you need to start at J2, alter the initial cell
PDFarray = .Range(.Cells(1, 10), .Cells(.Rows.Count, 10).End(xlUp))
End With
'convert to a 1D array
PDFarray = WorksheetFunction.Transpose(PDFarray)
'Note the use of `Select` and `ActiveSheet` when using this `ExportAsFixedFormat` method
Worksheets(PDFarray).Select
'Create PDF from the array above
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFLoc & PDFName, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
What #RonRosenfeld has suggested is correct about select and selection. The expression you are building is string whereas, Excel expects it to be real array.
So in principle an approach like below shall work for you which will create an array for processing and can be used as you want to utilise.
Dim shtNames As Variant
Dim pdfArray
shtNames = Range("J2:J" & Range("J1").Offset(Rows.Count - 1, 0).End(xlUp).Row).Value
pdfArray = Application.Transpose(shtNames)
I'm currently writing a multi-userform workbook that will check guests into the system by adding points. I'm attempting to make it more personalized by having the Main Label on the "Check In Form" respond to the guest by name once they checked in. I'm also making another userform that displays all of the guests information if they ask for it.
Right now I have 2 concerning issues I have attempted to debug via other online resources.
1) During check in, I use an array called Profile to retrieve all information from that person. When I call out the range to add to the array, I end up with Error 9 "Subscript out of range." To remedy this, I attempted to ReDim Preserve the array, only to find out that my information has been cleared anyway.
Option Explicit
Dim Profile() as Variant, Point as Integer
Sub CheckIn()
ActiveCell.Offset(0, 6).Select
ActiveCell.Value = ActiveCell.Value + Point
If ActiveCell.Value >= 10 Then
ActiveCell.Value = ActiveCell.Value - 10
MsgBox ("Congradulations! You just earned one free Engineering Pad. Talk to your Membership chair to recieve your free pad.")
End If
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Value + Point
Profile() = Array(Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 12)))
'data is Error 9 here
ReDim Preserve Profile(0 To 11)
'data is cleared here
MainLabel.Caption = "Hello " & Profile(1) & " " & Profile(2) & ". You Have " & Profile(7) & " Points."
ActiveCell.EntireRow.Select
Application.Wait (Now + #12:00:05 AM#)
MainLabel.Caption = "Please Enter Your 9-Digit ID or Swipe Your Card"
End Sub
In addition, changing the data type from Variant to String only produces a type mismatch when I attempt to add the data to the Profile, even when Split() is used. How can this be fixed? Any advice is appreciated. Thank you!
Here is an image of my spreadsheet
When you assign values from a range of cells into a variant array, you always get a two dimensioned, 1-based array; even if that array is only 1 to 1 as the second rank (columns) or, as in your case, 1 to 1 in the first rank (rows).
dim profile as variant, acrw as long
acrw = activecell.row
with worksheets("MySheet1") 'know what worksheet you are on!!!!!
profile = .Range(.Cells(acrw, 1), .cells(acrw, 12)).value2
'the following should be 1:1 and 1:12
debug.print lbound(profile, 1) & ":" & ubound(profile, 1)
debug.print lbound(profile, 2) & ":" & ubound(profile, 2)
'why are you redimming this at all?
'ReDim Preserve Profile(0 To 11)
'the following adds room for two more columns of data while preserving the values
ReDim Preserve Profile(1 to 1, 1 To 14)
end with
You can only use the ReDim statement with Preserve to change the dimension of the second rank; never the first.
Use the LBound and UBound functions to determine the limits (aka boundaries) of your array.
Range() does not need an Array() around it to get the values... Also, Range will always produce either a singe value, or a 2 dimensional array.
Change:
Profile = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 12))
'note the lack of parentheses
Also, as the row is the first element, you cannot redim the array with preserve, as preserve only works on the final dimension of the array.
ReDim Preserve Profile(0 To 11,0 to 2) would work but
ReDim Preserve Profile(0 To 22,0 to 1) would fail, as preserve is invalid in this context
I have 6 worksheets, each has a subcategory of data (it is important they are in separate worksheets). I am loading up the data into arrays because there are thousands of rows, then printing them out in a specific format to a .txt file.
Sub ExcelToXML()
Dim headers(), data(), attributes1(), attributes2(), attr$, r&, c&
Dim rowCount As Long
Dim columnCount As Long
Dim FF As Worksheet
Dim FOPR As Worksheet
Dim R1 As Long
Dim C1 As Long
Set FF = Worksheets("Fairy")
Set FOPR = Worksheets("Opera")
rowCount = (FF.Range("A1048576").End(xlUp).Row) 'Only one defined as rowCount should be consistent
ffcolumncount = (FF.Range("XFD1").End(xlToLeft).Column)
FOPRcolumnCount = FOPR.Range("XFD1").End(xlToLeft).Column
' load the headers and data to an array '
FFheaders = Cells(1, 1).Resize(1, ffcolumncount).Value
FFdata = Cells(1, 1).Resize(rowCount, ffcolumncount).Value
FOPRheaders = Cells(1, 1).Resize(1, FOPRcolumnCount).Value
FOPRdata = Cells(1, 1).Resize(rowCount, FOPRcolumnCount).Value
' set the size for the attributes based on the columns per child, dynamic
ReDim attributes1(1 To ffcolumncount)
ReDim attributes2(1 To FOPRcolumnCount)
' open file and print the header two main parents
Open "C:\desktop\ToGroup.xml" For Output As #1 'file path is here, going to change to save prompt
Print #1, "<Parent>"
Print #1, " <Child>"
' iterate each row non inclusive of headers
For r = 2 To UBound(FFdata)
' iterate each column '
For c = 1 To UBound(FFdata, 2)
' build each attribute '
attr = FFheaders(1, c) & "=""" & FFdata(r, c) & """"
attributes1(c) = FFheaders(1, c) & "=""" & FFdata(r, c) & """"
Next
For R1 = 2 To UBound(FOPRdata)
For C1 = 1 To UBound(FOPRdata, 2)
attr = FOPRheaders(1, c) & "=""" & FOPRdata(r, c) & """"
attributes2(c) = FOPRheaders(1, c) & "=""" & FOPRdata(r, c) & """"
Next
I cut it off at the prining and at 2 for next loops. (Not actually sure if the for..next loops are structured properly). Anyways, my question is, am I redimensioning wrong? It gives me 'subscript out of range' error on the second attribute. Is the line
ReDim attributes2(1 To FOPRcolumnCount)
the issue? As it may be dimensioning the array in the original worksheet. Perhaps I should define the arrays in separate or worksheet models? Can I and how would I reference them? Is there a way to make the array specifically refer to a worksheet?
Appreciate any input. It's really hard not having anyone around who can provide a second opinion.
Try replacing 'FOPRcolumnCount' with an actual value. If it solves your problem then the issue is with how 'FOPRcolumnCount' is calculated, which I think is where your problem lies. It's hard to tell from your example, but it appears you are trying to find the right most column on row#1 ; there are easier ways of doing that. Same with rowCount.
I notice you haven't declared it as a variable. Always declare your variables; put "Option Explicit" at the top of your module to force you to declare all variables.
Building off of one of my past questionsWhat I'm looking to accomplish:
I'm looking to find and highlight duplicate Upcharges using VBA code based on multiple criteria:
Product's XID (Column A)
Upcharge Criteria 1 (Column CT)
Upcharge Criteria 2 (Column CU)
Upcharge Type (Column CV) and
Upcharge Level (Column CW)
If there is more than one instance/row in a spreadsheet that share/match ALL of these criteria then that means the Upcharge is a duplicate. As seen in my previous post linked above:
What I've tried:
Created a general formula (see below) that is inserted into a Helper column and copied all the way down the spreadsheet which points out which Upcharges are duplicate. This method was too resource heavy and took too long (8-10 minutes for all the formulas to calculate, but doesn't lag when filtering). Then I tried
Evolved the general formula into a Conditional Formatting Formula and applied it to the Upcharge Name column via VBA code.(Takes same amount of time AND lags when filtering)
I've also looked into possibly using a scripting.dictionary, but I'm not sure how (or if) that would work with a multi-dimensional array.
Now I've finally found the method I think will be much faster,
The faster method I'm looking to use:
Dumping the aforementioned columns into a multi-dimensional array, finding the duplicate "rows" in the array, then highlighting the corresponding spreadsheet rows.
My attempt at the faster method:
Here's how I populate the multi-dimensional array
Sub populateArray()
Dim arrXID() As Variant, arrUpchargeOne() As Variant, arrUpchargeTwo() As Variant, arrUpchargeType() As Variant, arrUpchargeLevel() As Variant
Dim arrAllData() As Variant
Dim i As Long, lrow As Long
lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
arrXID = Range("A2:A" & lrow) 'amend column number
arrUpchargeOne = Range("CT2:CT" & lrow)
arrUpchargeTwo = Range("CU2:CU" & lrow)
arrUpchargeType = Range("CV2:CV" & lrow)
arrUpchargeLevel = Range("CW2:CW" & lrow)
ReDim arrAllData(1 To UBound(arrXID, 1), 4) As Variant
For i = 1 To UBound(arrXID, 1)
arrAllData(i, 0) = arrXID(i, 1)
arrAllData(i, 1) = arrUpchargeOne(i, 1)
arrAllData(i, 2) = arrUpchargeTwo(i, 1)
arrAllData(i, 3) = arrUpchargeType(i, 1)
arrAllData(i, 4) = arrUpchargeLevel(i, 1)
Next i
End Sub
I can get the columns into the array, but I get stuck from there. I'm not sure how to go about checking for the duplicate "rows" in the array.
My questions:
Is there a way I can apply my formula (see below) from my first attempt in my previous post and apply it inside the array?:
Or, even better, is there a faster way I can find the duplicate "rows" inside the array?
Then how could I go about highlighting the Upcharge Name (CS) cell in the spreadsheet rows that correspond with the "rows" in the array that were flagged as duplicates?
Formula from my previous post for reference:
=AND(SUMPRODUCT(($A$2:$A$" & lastRow & "=$A2)*($CT$2:$CT$" & lastRow & "=$CT2)*($CU$2:$CU$" & lastRow & "=$CU2)*($CV$2:$CV$" & lastRow & "=$CV2)*($CW$2:$CW$" & lastRow & "=$CW2))>1,$CT2 <> """")"
Returns TRUE if Upcharge is a duplicate
You say identify duplicates; I hear Scripting.Dictionary object.
Public Sub lminyDupes()
Dim d As Long, str As String, vAs As Variant, vCTCWs As Variant
Dim dDUPEs As Object '<~~ Late Binding
'Dim dDUPEs As New Scripting.Dictionary '<~~ Early Binding
Debug.Print Timer
Application.ScreenUpdating = False '<~~ uncomment this once you are no longer debugging
'Remove the next line with Early Binding¹
Set dDUPEs = CreateObject("Scripting.Dictionary")
dDUPEs.comparemode = vbTextCompare
With Worksheets("Upcharge") '<~~ you know what worksheet you are supposed to be on
With .Cells(1, 1).CurrentRegion
With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
.Columns(97).Interior.Pattern = xlNone '<~~ reset column CS
'the following is intended to mimic a CF rule using this formula
'=AND(COUNTIFS(A:A, A2, CT:CT, CT2, CU:CU, CU2, CV:CV, CV2, CW:CW, CW2)>1, SIGN(LEN(CT2)))
vAs = .Columns(1).Value2
vCTCWs = Union(.Columns(98), .Columns(99), .Columns(100), .Columns(101)).Value2
For d = LBound(vAs, 1) To UBound(vAs, 1)
If CBool(Len(vCTCWs(d, 1))) Then
'make a key of the criteria values
str = Join(Array(vAs(d, 1), vCTCWs(d, 1), vCTCWs(d, 2), vCTCWs(d, 3), vCTCWs(d, 4)), ChrW(8203))
If dDUPEs.exists(str) Then
'the comboned key exists in the dictionary; append the current row
dDUPEs.Item(str) = dDUPEs.Item(str) & Chr(44) & "CS" & d
Else
'the combined key does not exist in the dictionary; store the current row
dDUPEs.Add Key:=str, Item:="CS" & d
End If
End If
Next d
'reuse a variant var to provide row highlighting
Erase vAs
For Each vAs In dDUPEs.keys
'if there is more than a single cell address, highlight all
If CBool(InStr(1, dDUPEs.Item(vAs), Chr(44))) Then _
.Range(dDUPEs.Item(vAs)).Interior.Color = vbRed
Next vAs
End With
End With
End With
dDUPEs.RemoveAll: Set dDUPEs = Nothing
Erase vCTCWs
Application.ScreenUpdating = True
Debug.Print Timer
End Sub
This seems faster than the formula approach.
¹ If you plan to convert the late binding of the Scripting.Dictionary object to early binding, you must add Microsoft Scripting Runtime to the VBE's Tools ► References.
Conditional Formatting and Filtering
SUMPRODUCT vs COUNTIFS
First off, your choice of functions was inappropriate for such a large number of rows coupled with several conditions. A COUNTIFS function can perform many of the same multiple criteria operations that a SUMPRODUCT function can but in typically 25-35% of the calculation load and time. Additionally, full column references can be used without detriment in COUNTIFS as the column references are internally truncated at the limits of the Worksheet.UsedRange property.
Your standard formula can be written with COUNTIFS as,
=AND(COUNTIFS(A:A, A2, CT:CT, CT2, CU:CU, CU2, CV:CV, CV2, CW:CW, CW2)>1, CT2<>"")
'... or,
=COUNTIFS(A:A, A2, CT:CT, CT2, CT:CT, "<>", CU:CU, CU2, CV:CV, CV2, CW:CW, CW2)>1
Bringing the non-blank column CT condition directly into the COUNTIFS function actually improved calculation time slightly.
Only Calculate When You Have To
The original formula can be broken down to two main conditions.
Is the cell in column CT non-blank?
Do the values in five columns match the same five columns any other row?
A rudimentary IF function halts processing if the condition is not true. If the test for a non-blank cell in column CT is moved into a wrapping IF then the COUNTIFS (the bulk of the calculation) will only be processed if there is a value in the current row's CT column.
The improved standard formula becomes,
=IF(CT2<>"", COUNTIFS(A:A, A2, CT:CT, CT2, CU:CU, CU2, CV:CV, CV2, CW:CW, CW2)>1)
The benefits for this modification depend upon the number of blank cells in column CT. If only 1% of the 15,000 cells are blank, very little improvement will be noticed. However, if 50% of the cells in column CT are typically blank there will be a substantial improvement as you are literally knocking your calculation cycles in half.
Sorting the Data to Limit the Ranges
By far, the biggest calculation parasite is with the COUNTIFS looking through 15,000 rows of data in five separate columns. If the data was sorted on one or more of the criteria columns then it becomes unnecessary to look through all 15,000 rows for matches to all five columns of criteria.
For the purpose of this exercise, it will be assumed that column A is sorted in an ascending manner. If you want to test the hypothesis discussed here, sort the data now.
The INDEX function does more than return a value; it actually returns a valid cell address. When used in its most common lookup capacity, you see the value returned but in reality, unlike a similar VLOOKUP operation which only return the cell's value, INDEX is returning the actual cell; e.g. =A1, not the 99 that A1 contains. This hyper-functionality can be used to create valid ranges that can be used in other functions. e.g. A2:A9 can also be written as INDEX(A:A, 2):INDEX(A:A, 9).
This functionality cannot be used directly within a Conditional Formatting rule. However, it can be used in a Named Range and a Named Range can be used in a Conditional Formatting rule.
tl;dr
Sub lminyCFrule()
Debug.Print Timer
'Application.ScreenUpdating = False '<~~ uncomment this once you are no longer debugging
On Error Resume Next '<~~ needed for deleting objects without checking to see if they exist
With Worksheets("Upcharge") '<~~ you know what worksheet you are supposed to be on
If .AutoFilterMode Then .AutoFilterMode = False
'delete any existing defined name called 'localXID' or 'local200'
With .Parent
.Names("localXID").Delete
.Names("local200").Delete
End With
'create a new defined name called 'localXID' for CF rule method 1
.Names.Add Name:="localXID", RefersToR1C1:= _
"=INDEX('" & .Name & "'!C1:C104, MATCH('" & .Name & "'!RC1, '" & .Name & "'!C1, 0), 0):" & _
"INDEX('" & .Name & "'!C1:C104, MATCH('" & .Name & "'!RC1, '" & .Name & "'!C1 ), 0)"
'create a new defined name called 'local200' for CF rule method 2
.Names.Add Name:="local200", RefersToR1C1:= _
"=INDEX(Upcharge!C1:C104, MAX(2, ROW()-100), 0):INDEX(Upcharge!C1:C101, ROW()+100, 0)"
With .Cells(1, 1).CurrentRegion
'sort on column A in ascending order
.Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
'create a CF rule on column CS
With .Resize(.Rows.Count - 1, 1).Offset(1, 96)
With .FormatConditions
.Delete
' method 1 and method 2. Only use ONE of these!
' method 1 - definitively start and end of XIDs in column A (slower, no mistakes)
'.Add Type:=xlExpression, Formula1:= _
"=IF(CT2<>"""", COUNTIFS(INDEX(localXID, 0, 1), A2, INDEX(localXID, 0, 98), CT2," & _
"INDEX(localXID, 0, 99), CU2, INDEX(localXID, 0, 100), CV2," & _
"INDEX(localXID, 0, 101), CW2)-1)"
' method 2 - best guess at start and end of XIDs in column A (faster, guesswork at true scope)
.Add Type:=xlExpression, Formula1:= _
"=IF(CT2<>"""", COUNTIFS(INDEX(local200, 0, 1), A2, INDEX(local200, 0, 98), CT2," & _
"INDEX(local200, 0, 99), CU2, INDEX(local200, 0, 100), CV2," & _
"INDEX(local200, 0, 101), CW2)-1)"
End With
.FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 3
End With
'Filter based on column CS is red
.Columns(97).AutoFilter Field:=1, Criteria1:=vbRed, Operator:=xlFilterCellColor
End With
End With
Application.ScreenUpdating = True
Debug.Print Timer
End Sub
While not screaming fast, this does the job handily. The 'best guess' is faster than the 'definitive start and finish' but you run the risk of not completely covering the scope of the duplicates in column A. Of course, the offsets (e.g. 100 up and down) that control the scope could be adjusted.
Why don't you remove the Indirect() and replace the Countif() function with some stable Row reference. Since Indirect() part is a volatile and instead of using Indirect() you can straight away use some stable row reference like $A$2:$A$50000 which may show some significant change in performance.
Or
Use Create Table for your data. Use Table reference in your formula which will work faster than Indirect() reference.
Edit
Your actual formula
=AND(SUMPRODUCT(($A$2:$A$500=$A2)*($CU$2:$CU$500=$CU2)*($CV$2:$CV$500=$CV2)*($CW$2:$CW$500=$CW2)*($CX$2:$CX$500=$CX2))>1,$CU2 <> "")
Why don't you convert it to Counti(S) with stable reference like the below?
=AND(COUNTIFS($A$2:$A$500,$A2,$CU$2:$CU$500,$CU2,$CV$2:$CV$500,$CV2,$CW$2:$CW**$500,$CW2,$CX$2:$CX$500,$CX2)>1,$CU12<>"")
Consider an SQL solution as this is a typical aggregate group by query where you filter for counts greater than 1. To go about your route requires many conditional logic within the loop across all elements of array.
While I recommend you simply import your data into a database like Excel's sibling MS Access, Excel can run SQL statements on its own workbook using an ADO connection (not to get into particulars but both Excel and Access uses the same Jet/ACE engine). And one good thing is you seem to be set up to run such a query with the table like structure of named columns.
The below example references your fields in a worksheet called Data (Data$) and query outputs to a worksheet called Results (with headers). Change names as needed. Two connection strings are included (one of which is commented out). Hopefully it runs on your end!
Sub RunSQL()
Dim conn As Object, rst As Object
Dim i As Integer, fld As Object
Dim strConnection As String, strSQL As String
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' Connection and SQL Strings
' strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
' & "DBQ=C:\Path\To\Workbook.xlsm;"
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='C:\Path\To\Workbook.xlsm';" _
& "Extended Properties=""Excel 8.0;HDR=YES;"";"
strSQL = " SELECT [Data$].[Product's XID], [Data$].[Upcharge Criteria 1]," _
& " [Data$].[Upcharge Criteria 2], [Data$].[Upcharge Type]," _
& " [Data$].[Upcharge Type], [Data$].[Upcharge Level]" _
& " FROM [Data$]" _
& " GROUP BY [Data$].[Product's XID], [Data$].[Upcharge Criteria 1]," _
& " [Data$].[Upcharge Criteria 2], [Data$].[Upcharge Type]," _
& " [Data$].[Upcharge Type], [Data$].[Upcharge Level]," _
& " [Data$].[Product's XID]" _
& " HAVING COUNT(*) > 1;"
' Open the db connection
conn.Open strConnection
rst.Open strSQL, conn
' Column headers
i = 0
Worksheets("Results").Range("A1").Activate
For Each fld In rst.Fields
ActiveCell.Offset(0, i) = fld.Name
i = i + 1
Next fld
' Data rows
Worksheets("Results").Range("A2").CopyFromRecordset rst
rst.Close
conn.Close
End Sub
This might work like a magic trick, but not sure if it would work.
Could you just create another supportive (temporary) column, concatenating all four criteria?
ZZ_Temp = concatenate (CS; CV; CZ; etc)
This way, I suppose, you could show/highlight duplicates a lot faster.
In classic ASP I need to extract data out of a MSSQL database, passing the results to a two dimensional array (rows, columns) and display the data in various formats.
For each such format I need to build functions to display data. So, in order to be as modular as possible I need to separate (i) extraction and passing data to the array from (ii) displaying the results.
My code does currently the extraction of data using a class, but also displays (within the same class) the data in a primitive way (just to test that the data is extracted and correct).
How can I pass such array to a function? You can imagine how flexible would be to have an array as data input into a function and then manipulate it (creating many functions) when trying to display it in a table (example: function 1 will be based on template no. 1 of a table that is red with background black and no borderline, function 2 is built on the template 2, the table is green, with borderline and yellow background, etc etc).
Here is my code and at the end of the main function (within the class) you will see a portion that displays results, i.e. the one that I need to do it separately from / outside the class (i.e. in the functions to be created).
<!--#include file ="../functions/fctGetnrofrecords.asp"-->
<%
Dim db : Set db = New GetRowsFromAdatabase
db.strTable="Customers"
strDisplay=db.FindOutRecordsAndPassThemToAnArray()
Response.Write strDisplay
Class GetRowsFromAdatabase
Public strTable
Public numberOfRecords
Public numberOfFields
Public Function FindOutRecordsAndPassThemToAnArray()
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
'Find out connecting credentials
strSERVERspecific=Coli(0)
strDATABASENAMEspecific=Coli(1)
strUIDspecific=Coli(2)
strPWDspecific=Coli(3)
conn.Open "Provider=SQLOLEDB;server=" & strSERVERspecific & ";database=" & strDATABASENAMEspecific & ";uid=" & strUIDspecific & ";pwd=" & strPWDspecific & ";"
rs.Open strTable, conn
if rs.EOF and rs.BOF then
strError = "There is no record in the table " & strTable
else
'Assign the Number Of Fields to the variable “counter”
counter = rs.fields.count
numberOfFields=counter
Dim matrix(25, 10) ' these exceed by far the values of numberOfRecords and numberOfFields
for j=0 to counter-1
matrix(0,j)= rs.Fields(j).Name ' The first dimension of the array, when is zero,
' is populated with the names of fields
next
rs.movefirst
i=1
do until rs.EOF
for j=0 to counter-1
matrix(i,j)=rs(j)
next
i=i+1
rs.movenext
loop
end if
' Now, I need this class not to include the displaying section that follows
' (i.e. see the portion until the end of this function), although this section works fine
numberOfRecords=fctGetNumberOfRowsOfaTable(strTable)
'see the include directive at the beginning of this code (there is a function there that does this)
'====begin section that displays the arrays values
for m = 0 to numberOfRecords
for n=0 to counter-1
strDisplay = strDisplay & m & "," & n & "=" & matrix(m,n) & "<br>"
next
next
'====end section that displays the array values
FindOutRecordsAndPassThemToAnArray = strDisplay
End Function
Public Function Coli(x)
'This function read a line of a txt file located on the server side (hidden from public / httpdocs)
' where x = the relevant line out of the following
' 1 means the 1st line = name / IP server
' 2 means the 2nd line = database name
' 3 means the 3rd line = user name available in the database
' 4 means the 4th line = user’s password
if x<0 or x> 3 then
Coli="Erorr"
Exit Function
else
serv=Server.MapPath("../../../")
path=serv & "\somehiddenfolder\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(path & "configuration.txt")
J=0
Dim Datele(3)
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
if x=J then
Coli=strNextLine
exit function
else
J=J+1
end if
Loop
end if
End Function
End Class
%>
Any hints will be highly appreciated.
Use .GetRows to get an array of a table/resultset. To pass such an array to a function (why function? what should be its return value?) you write its name in the argument list of the function call.
Update wrt comment:
Sample of calling a function that expects an array:
>> Function sum(a)
>> sum = Join(a, "+")
>> End Function
>> a = Split("1 2 3")
>> WScript.Echo sum(a)
>>
1+2+3
Instead of Split() - which returns a one dimensional array - you'd use .GetRows() on a valid recordset (and keep in mind that .GetRows() returns a two dimensional array).