I have a VBA program I am working on, which so far involves 2 steps.
Step 1:
Takes from the tab "Compiler" all the elements in 3 adjacent columns and arranges the unique combinations that occur across the rows of these columns in the first three columns of the "Annual Summary" tab.
Ex/
In the compiler tab the three columns look like:
2013 Montreal OCC
2013 Montreal OCC
2013 Sarnia OSH
2012 Montreal OCC
The code will output in the annual summary tab:
2012 Montreal OCC
2013 Montreal OCC
2013 Sarnia OSH
This was working fine, and then I tried to add the next step...
Step 2:
In the annual summary tab, I then want to perform a vlookup off of the third column (OCC, OSH). The range I want the vlookup to be performed using is in "conversion units" tab. I want to have a loop that checks for the third column (OCC, OSH) cells to be full and then performs the vlookup returning the desired value to the adjacent cell in the fourth column; if they are not full I want the execution to stop.
I wrote a code for this, but two things have happened that I wish to rectify:
1) My original list of unique combinations in the first three columns repeats itself once (so I have two times the number of entries I want); and
2) I have a #N/A error filling the fourth column.
I have attached a sample version of the file so you can see the layout, but I had to remove the VBA code due to size. I have posted the code I current have below for your review. Note that the actual cell references are slightly different than the sample file I have provided. I don't think this should matter though.
Any help would be hugely appreciated.
Sub AnnualSummary()
'Column titles
Worksheets("Annual Summary").Activate
Range("A1").Value = "Annum"
Range("B1").Value = "Refinery"
Range("C1").Value = "Crudes"
Range("D1").Value = "Sample Site"
Range("E1").Value = "Quantity (bbl)"
Range("F1").Value = "Average Price Per Bbl"
Range("G1").Value = "Average API"
Range("H1").Value = "Average % wt. Sulphur"
'Column titles font setup
Range("A1:H1").Font.Bold = True
Range("A1:H1").Font.Underline = True
Range("A1:H1").HorizontalAlignment = xlCenter
'Naming ranges
Workbooks("Co-op Compiler.xlsm").Worksheets("Compiler").Range("B2:B1436").Name = "Year"
Workbooks("Co-op Compiler.xlsm").Worksheets("Compiler").Range("C2:C1436").Name = "Location"
Workbooks("Co-op Compiler.xlsm").Worksheets("Compiler").Range("E2:E1436").Name = "Crude"
'Identifying and placing unique combinations of named ranges
Dim sh As Worksheet, target_sh As Worksheet
Dim lrow As Long, data, result, i As Long, n As Long, j As Long, mystr As String
Set sh = Sheets("Compiler")
lrow = sh.Cells(Rows.Count, 2).End(xlUp).Row
If lrow = 1 Then Exit Sub
Set target_sh = Sheets("Annual Summary")
data = sh.Range("r1:t" & lrow)
ReDim result(1 To lrow, 1 To 3)
For i = 2 To lrow
If InStr(mystr, "|" & data(i, 1) & data(i, 2) & data(i, 3) & "|") = 0 Then
mystr = mystr & "|" & data(i, 1) & data(i, 2) & data(i, 3) & "|"
j = j + 1
For n = 1 To 3
result(j, n) = data(i, n)
Next
End If
Next
Application.ScreenUpdating = 0
target_sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(j, 3) = result
target_sh.UsedRange.EntireColumn.AutoFit
Application.ScreenUpdating = 1
'Vlookup crude source off of crude type
Workbooks("Co-op Compiler.xlsm").Worksheets("Conversion Units").Range("D2:E45").Name = "Sources"
Dim CrudeType As Range
Dim Source As Variant
Set CrudeType = Workbooks("Co-op Compiler.xlsm").Worksheets("Annual Summary").Range("c:c")
Sheets("Annual Summary").Activate
For Each cell In CrudeType
If cell.Value <> "" Then
cell.Offset(0, 1).Value = Source
Source = WorksheetFunction.VLookup(CrudeType, Range("Sources"), 2, False)
End If
Next
End Sub
Bookmarks