VBA Array, but getting error

[cks30]

I'm new to VBA, and am trying to write code to create an array However, I'm getting errors. Any help would be greatly, greatly appreciated.

Sub Array_Weights_Dims()


Dim TEMPLATEbook As String 'variable for the name of the template workbook
Dim TEMPLATEsheet As String 'variable for the name of the template sheet
Dim Next1 As Boolean 'sentinel to check for end of records/file
Dim Next2 As Boolean 'sentinel to check for end of records/file
Dim Next3 As Boolean 'sentinel to check for end of records/file
Dim Next4 As Boolean 'sentinel to check for end of records/file
Dim RECORDcnt As Long 'variable for counting the records in the template file, for looping
Dim realHDR As Long 'variable for counting the records in the template file, for looping
Dim countHDR As Long 'var to count nbr of columns of data in the template file (cannot use selectx1Right because valid blank columns)
Dim Array_Weights_Dims ' x1 dimension array for the unique plants in the template file
Dim colPN, colUPC, colPRICE, colPALLET, colUWEIGHT, colULENGTH, colUWIDTH, colUHEIGHT, colMPKQ, colMPKWEIGHT, colMPKL, colMPKWIDTH, colMPKH, colCOO, colFAMILY, colHTC, colCOMMENTS As Integer



Dim SUBJplant As String 'sentinel used for looping as part building the unique plant array
'Dim DUPplant As Boolean 'sentinel used for looping as part building the unique plant array
Dim c As Integer 'c is loop variable for unique plant table evaluation
Dim SUBJrecord As Integer


Workbooks.Open Filename:=TEMPLATE_fileNM
TEMPLATEbook = ActiveWorkbook.Name

' Count number of headers in the template file
countHDR = 0
Do
Next1 = False
Next2 = False
Next3 = False
Next4 = False
countHDR = countHDR + 1
If Trim(Cells(3, countHDR + 1)) = "" Then Next1 = True
If Trim(Cells(3, countHDR + 2)) = "" Then Next2 = True
If Trim(Cells(3, countHDR + 3)) = "" Then Next3 = True
If Trim(Cells(3, countHDR + 4)) = "" Then Next4 = True
Loop While Next1 = False Or Next2 = False Or Next3 = False Or Next4 = False

'Capture Header Locations (UPDATED)
X = 0
realHDR = 0

Do
X = X + 1
If Cells(3, X) = "PART NUMBER" Then
colPN = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "DESCRIPTION" Then
colDESC = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "UPC" Then
colUPC = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "PRICING" Then
colPRICE = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "PALLET QUANTITY" Then
colPALLET = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "UNIT WEIGHT (KG)" Then
colUWEIGHT = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "UNIT LENGTH (CM)" Then
colULENGTH = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "UNIT WIDTH (CM)" Then
colUWIDTH = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "UNIT HEIGHT (CM)" Then
colUHEIGHT = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "MULTI-PACK QTY" Then
colMPKQ = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "MULTI-PACK WEIGHT (KG)" Then
colMPKWEIGHT = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "MULTI-PACK LENGTH (CM)" Then
colMPKL = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "MULTI-PACK WIDTH (CM)" Then
colMPKWIDTH = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "MULTI-PACK HEIGHT (CM)" Then
colMPKH = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "COUNTRY OF ORIGIN" Then
colCOO = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "PRODUCT FAMILY" Then
colFAMILY = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "SCHEDULE B" Then
colHTC = X
realHDR = realHDR + 1
ElseIf Cells(3, X) = "COMMENTS" Then
colCOMMENTS = X
realHDR = realHDR + 1

End If

Loop While X < countHDR



' Capture the template values
ReDim Array_Weights_Dims(realHDR + 3, 4)
' row = realHDR + 3
is count of actual headers +1 for ZERO position +2 for G.P.
' col = 4 is arbitrary as starting point, will be redim'ed in procedure as required
Array_Weights_Dims(0, 1) = realHDR ' count of headers identified in the USER EXIT TEMPLATE file as identified above
Array_Weights_Dims(0, 2) = 0 ' count of actual items/records in the USER EXIT TEMPLATE file
'col = 4 is arbitrary as starting point, will be redim'ed in procedure as required
recordscnt = 2
Do
Next1 = False
Next2 = False
Next3 = False
Next4 = False
recordscnt = recordscnt + 1
If Trim(Cells(recordscnt, 2)) = "" Then GoTo SKIPblank:
'use for SKU POR
Array_Weights_Dims(0, 2) = Array_Weights_Dims(0, 2) + 1
ReDim Preserve Array_Weights_Dims(realHDR + 3, Array_Weights_Dims(0, 2) + 4)
' fixed_VKORGcol , fixed_WERKScol, fixed_PROFILEcol, fixed_MATNRcol, fixed_PLANT2col, fixed_BLANKcol, fixed_NBRcol, fixed_FLAGcol

Array_Weights_Dims(1, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colPN) ' part number
Array_Weights_Dims(2, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colDESC) ' Description
Array_Weights_Dims(3, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colPRICE) ' PRICING
Array_Weights_Dims(4, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colUPC) ' UPC
Array_Weights_Dims(5, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colPALLET) ' pallet
Array_Weights_Dims(6, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colUWEIGHT) ' unit weight
Array_Weights_Dims(7, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colULENGTH) ' unit length
Array_Weights_Dims(8, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colUWIDTH) ' unit width
Array_Weights_Dims(9, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colUHEIGHT) ' unit height
Array_Weights_Dims(10, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colMPKQ) ' multi pack qty
Array_Weights_Dims(11, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colMPKWEIGHT) ' multi pack weight
Array_Weights_Dims(12, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colMPKL) ' multi pack length
Array_Weights_Dims(13, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colMPKWIDTH) ' multi pack width
Array_Weights_Dims(14, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colMPKH) ' multi pack height
Array_Weights_Dims(15, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colCOO) ' Country of Origin
Array_Weights_Dims(16, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colFAMILY) ' Product Family
Array_Weights_Dims(17, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colHTC) ' Schedule B
Array_Weights_Dims(18, Array_Weights_Dims(0, 2)) = Cells(recordscnt, colCOMMENTS) ' Comments



SKIPblank:
If Cells(recordscnt + 1, 1) = "" Then Next1 = True
If Cells(recordscnt + 2, 1) = "" Then Next2 = True
If Cells(recordscnt + 3, 1) = "" Then Next3 = True
If Cells(recordscnt + 4, 1) = "" Then Next4 = True
Loop While Next1 = False Or Next2 = False Or Next3 = False Or Next4 = False


' Template values have been captured, close the template file (Toolbox will still be open)
Application.DisplayAlerts = False
Workbooks(TEMPLATEbook).Close SaveChanges:=False
Application.DisplayAlerts = True

 

[AlphaFrog]

When posting a large amount of code like this, surround the code with CODE tags (see my signature block below). It makes reading your code much easier.

What is the error description?
What line of code is highlighted when you click the Debug button on the error dialog?

You set values to the col variables when a column header is matched. You then use all the col variables to fill the array. If a col variable is not matched, it is empty, but you still try to use it to fill the array. That will cause an error. You need to make sure all the col variables have a value or not use the empty ones.

 

[cks30]

Thank you very much. I've been able to get the macro running. Is there something I can write to export the array in a worksheet just to make sure all the data is captured?

 

[AlphaFrog]

Thank you very much. I've been able to get the macro running. Is there something I can write to export the array in a worksheet just to make sure all the data is captured?

You're welcome.

Copy the filtered data and paste it to a blank sheet.

 

[cks30]

The macro just creates an array that I will pass through to another macro. However, before continuing I was hoping I could export the array to insure it's correct before I go to the next step.

 

[AlphaFrog]

The macro just creates an array that I will pass through to another macro. However, before continuing I was hoping I could export the array to insure it's correct before I go to the next step.

You lost me. I don't have specifics on your data so all I can say is; Select the filtered data, copy it, select a blank worksheet and paste. If you need specific help, you'll have to provide much more detail.

 

[AlphaFrog]

Something like this would paste the array to a sheet.

Sheets("Sheet2").Range("A1").Resize(UBound(Array_Weights_Dims, 1) + 1, UBound(Array_Weights_Dims, 2) + 1).Value = Array_Weights_Dims

It's key to define the destination range the same size as the array