Duplicating Index in VBA

Lord Bowler

New Member
Joined
Dec 16, 2009
Messages
18
I'm working on automating a project. I have an excel template which matches our web form that I use to test the calculations in our online system and to test calc changes, "what ifs".

I extract the data set for all school districts state-wide and want to pull this information from this tab to my template tab via a macro automatically. I currently use an Index function to find the intersection of the District Code and the Reference Key.

I'm working on making a macro that will go down each row and pull the cell value after finding the intersection of the Row(District) and Column(RefKey) on my dataset tab.

I've got it working but it is clunky:

Sub Test()
Dim rows As Long
Dim cols As Long
Dim Refkey As String
Dim DistrictCode As String ' Gotten from cell that user types in.
DistrictCode = Range("D11").Value 'Will come from user input box.
Dim nrow As Long
nrow = 0

Do
Select Case Range("H15").Offset(nrow, 0).Value 'Initial row
Case "2009-10" ' Years are located in H.
' Set Refkey value without the # symbol
Refkey = Mid(Range("G15").Offset(nrow, 0).Text, 2)

' Get Row Location
rows = Application.WorksheetFunction.Match(DistrictCode, Sheets("2009-10").Range("A1:A750"), 0)

' Get Column Location
cols = Application.WorksheetFunction.Match(Refkey, Sheets("2009-10").Range("A5:DI5"), 0)

Range("I15").Offset(nrow, 0).Value = Sheets("2009-10").Cells(rows, cols).Value

Case Else
MsgBox "Else"
End Select

nrow = nrow + 1
Loop Until nrow = 40 'for testing purposes, will eventually go until last row.

End Sub

I've removed the other Case statements as I am using 3-4 datasets for various years.

Anyone know of a less clunky way to get the row and column offset?

Also, I need to trap for when a Refkey is not found easily and place a 0 or a note for testing purposes for cols=...

I will eventually be removing all cell refs and using relative locs so I can use this macro across all 20 template files that I have.

Thanks in advance.
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
This may or may not help. Here's how I would do it (not tested):

Code:
Sub Test()
    Dim rows As Long
    Dim cols As Long
    Dim Refkey As String
    Dim DistrictCode As String    ' Gotten from cell that user types in.
    DistrictCode = Range("D11").Value    'Will come from user input box.
    Dim nrow As Long
    Dim rngDC As Range, _
        rngRK As Range

    With Worksheets("2009-10")
        Set rngDC = .Range("A1:A750").Find(DistrictCode, LookIn:=xlValues)
        If rngDC Is Nothing Then Exit Sub

        For nrow = 15 To 40
            Refkey = Mid$(.Cells(nrow, 7).Text, 2)
            Set rngRK = .Range("A5:DI5").Find(Refkey, LookIn:=xlValues)
            If rngRK Is Nothing Then
                Exit Sub
            ElseIf Not Intersect(rngDC, rngRK) Is Nothing Then
                .Cells(nrow, 9).Value = Intersect(rngDC, rngRK).Value
            Else
                .Cells(nrow, 9).Value = "Not found"
            End If
        Next nrow
    End With

End Sub

HTH
 
Upvote 0
Thanks, I understand some of this code but not all. I do see the intent behind the code though.

Some more background:
My template sheet contains the following:
Line Number, Description, Text of formula, Value (which I want to get from extract file Sheet("2009-10"), Refkey (identifier), Year.

I have multiple extract sheets labeled as 2009-10, 2008-09, etc. with my refkeys in columns and my districts (District Codes) in rows.

Using your code I get no value for Intersect(rngDC, rngRK).

Modified code, with some new changes. I left my code in for 2008-09 and modified 2009-10 using your code.
********************
Sub Test2()
Dim rows As Long
Dim cols As Long
Dim Refkey As String
Dim DistrictCode As String
DistrictCode = Range("D11").Value
Dim nrow As Long
Dim rngDC As Range, _
rngRK As Range
' nrow = 0

Do
Range("H15").Offset(nrow, 0).Select ' (Selecting the cell so I can follow along)
Select Case Range("H15").Offset(nrow, 0).Value 'eighth column
Case "2009-10"
With Worksheets("2009-10")
Set rngDC = .Range("A1:A750").Find(DistrictCode, LookIn:=xlValues)
If rngDC Is Nothing Then Exit Sub
' Set Refkey value without the # symbol
Refkey = Mid(Range("G15").Offset(nrow, 0).Text, 2)
' Refkey = Mid$(.Cells(nrow, 0).Text, 2) 'Got an error Mid$(.Cells())
Set rngRK = .Range("A5:DI5").Find(Refkey, LookIn:=xlValues)
If rngRK Is Nothing Then
Exit Sub
ElseIf Not Intersect(rngDC, rngRK) Is Nothing Then
.Cells(nrow, 2).Value = Intersect(rngDC, rngRK).Value
Else
MsgBox "Else"
.Cells(nrow, 2).Value = "Not found"
End If
End With

Case "2008-09"
' Set Refkey value without the # symbol
Refkey = Mid(Range("G15").Offset(nrow, 0).Text, 2)

' Get Row Location
rows = Application.Match(DistrictCode, Sheets("2008-09").Range("A1:A750"), 0)

' Get Column Location
cols = Application.Match(Refkey, Sheets("2008-09").Range("A4:DI4"), 0)

If IsError(cols) Then
Range("I15").Offset(nrow, 0).Value = 0
Else
Range("I15").Offset(nrow, 0).Value = Sheets("2008-09").Cells(rows, cols).Value
If Range("I15").Offset(nrow, 0).Value = "" Then
Range("I15").Offset(nrow, 0).Value = 0
End If
End If

Case Else
MsgBox "Else"
End Select

nrow = nrow + 1
Loop Until Range("H15").Offset(nrow, 0) = "" ' nrow = 40
End Sub
********************

I get an error with the Mid$(.Cells()) command. Run-Time Error '1004': Application-defined or object-defined error.

It doesn't seem to like the .Cells() function. It also never sets "Not Found" for this .Cells(nrow, 2).Value = "Not found", but does not generate a stop error.

To debug, I tried to print the value of MsgBox Intersect(rngDC, rngRK).Value but I get an error. Run-time error '91': Object variable or With block variable not set.

I do get the value of my district code in rngDC and my refkey in rngRK.

Thanks for any info you can provide.
 
Upvote 0
I see some potential issues with the way you implemented, but it's hard to tell what the real problem is without your data. Can you post it?
 
Upvote 0
Here is an example of my data. There are 750 rows and 111 data columns in my 09-10 sheet.

Header Row Example:
DCODE, DISTRICT CODE, 25478, 25480, 45065, 45077, 45078, 45079, 45080, 45081, 45082, 45141, 47958, 47961, 47963, 48262, 48267, 48268, 48269, 48274, 48365, 48407, 48531, 49705, 49713, 49714, 49715, 49734, 49735, 49736, 49764, 49765, 49766, 49767, 49768, 49769, 49770, 49771, 49772, 49773, 49774, 49775, 49776, 49777, 49778, 49779, 49782, 49783, 49784, 49787, 49788, 49789, 49792, 49793, 49794, 49795, 49797, 49798, 49799, 49822, 49826, 49839, 49855, 50261, 50270, 50271, 50272, 50273, 50274, 50275, 50301, 50931, 50932, 50933, 50934, 51000, 51016, 51103, 51185, 51194, 53257, 53275, 53286, 53288, 53313, 53321, 53322, 53323, 53324, 53325, 53326, 53327, 53436, 62867, 63038, 63039, 63040, 63041, 63042, 85014, 85038, 85039, 85040, 85329, 85359, 85360, 85361, 85385, 85387, 85388, 85389, 85421, 85423,

Data - Row 1
010100, ALBANY CITY SD, 784097, 2382507, 116542, 376778, 0.707, 0.353, 0.706, 0.353, 0.706, 0, 681817, 190007, 79275, 7, 0, 0, 0, 4.931, 1538.25, 0, 4296232, 133116, 0.868, 0.355, 0.549, 31.992, 43.92, 478239, 138861192, 0, 0, 0, 0, 0.416, 0.584, 2277, 3502596, 613156, 613156, 0.36, 0.64, 392420, 1548, 0, 0, 0, 0, 0, 53455812, 54143352, 0, 54143352, 53590188, 553164, 22821462, 22204794, 616668, 3843336, 10888.85, 790680, 0, 186935, 0.502, 0.451, 0.549, 0.275, 0.525, 0.155, 0, 38021512, 60313927, 54487215, 6427450, 0, 0, 0, 2212854, 0, 12367, 6199.05, 18187446, 0, 80315702, 5153859, 4583.74, 1124, 0, 0, 0, 6179250, 4817489069, 12262, 1516, 885, 1361351, 0 , 0, 0, 0, 0, 0, 4826086, 38591, 0, 784097, 0, 3774535, 349796, 701755, 1344489, 53930675, 0

HTH.
 
Upvote 0
Based on the District Code entered by the user, the appropriate data is populated, currently by an Index formula, preferably by a Macro.

Thanks,
 
Upvote 0
I'm thinking that these ranges are finding the cell I need but not the range.

Set rngDC = .Range("A1:A750").Find(DistrictCode, LookIn:=xlValues)
Set rngRK = .Range("A5:DI5").Find(Refkey, LookIn:=xlValues)

ie: rngDC is finding my code ('010100', Cell:A2) but not setting the range as A2:DI2. rngRK is finding my refkey ('25478', Cell:C1) but not setting the range as C1:C750.

I believe if I solve this dilemma and set the ranges, the Intersect will work and find the cell I want (Cell:C2).

Thanks,
 
Upvote 0
Updated code:

Still trying to use the Intersect() function instead of the alternate method which is working.

Code:
Sub LoadData(DistrictCode)
' Load Data Macro
' Get District Data from Data Extract Sheets into Template via Macro
    ' Selects Extract Sheet based on Year.
    ' Call GetData to find values based on intersect.
' Prompt for District Code from user set to variable.
' Run macros to set flags first which calls this SUB.
    Worksheets("09-10 GEN Template").Activate
'    Dim DistrictCode As String
'    DistrictCode = Range("C2").Value  ' Get from user
    Dim nrow As Long
    Dim Year As String
    Dim Last As Range
    nrow = 0

    Set Last = Worksheets("09-10 GEN Template").Range("H65536").End(xlUp) ' Last

Do
Range("H2").Offset(nrow, 0).Select  ' Change for external sources...
Select Case Range("H2").Offset(nrow, 0).Value
    Case "2009-10"
        ' Set Year
        Year = "2009-10"
        ' Call GetData, Send Nrow (index), District Code, Year
        Call GetDataTest(nrow, DistrictCode, Year)

    ' Case for each Year="2008-09" which match data sheets, etc...

    Case Else
        ' MsgBox "Else"
        Range("I2").Offset(nrow, 0).Value = Null
End Select

nrow = nrow + 1
Loop Until nrow = 36 ' Range("H2").Offset(nrow, 0) = "END" ' nrow = 36
' Range("H2").Offset(nrow, 0) = Last.Offset(1, 0)

End Sub

Sub GetData(nrow, DistrictCode, Year)
' Get Data Macro
' Receives row counter, District Code & Year from Load Data Macro.
    ' Finds District Row from Extract based on Year in Year column.
    ' Finds RefKey Column from Extract based on RefKey in RefKey column.
    ' Finds the intersect of District and RefKey by Year by other means.
' Macro written 3/2/2010 by David J Duprey.
' Macro Last written 3/4/2010 by David J Duprey.
' Run macros to set flags first.
    Dim rows As Variant
    Dim cols As Variant
    Dim Refkey As String

    With Worksheets(Year)
        ' Set Refkey value without the # symbol
        Refkey = Mid(Range("G2").Offset(nrow, 0).Text, 2)

        ' Get Row Location
        rows = Application.Match(DistrictCode, .Range("A1:A800"), 0)

        ' Get Column Location
        cols = Application.Match(Refkey, .Range("A4:DZ4"), 0)

        ' If found value is null, then set value as 0
        If IsError(cols) Then
            Range("I2").Offset(nrow, 0).Value = 0
        Else
            Range("I2").Offset(nrow, 0).Value = .Cells(rows, cols).Value
            If Range("I2").Offset(nrow, 0).Value = "" Then
                Range("I2").Offset(nrow, 0).Value = 0
            End If
        End If
    End With
End Sub

Example: DistrictCode from user is 010100 or 140600 etc. Refkeys are 51194 or 53257 etc.

My thinking is that Intersect is not working because its tying to intersect two individual cells that don't intersect.

Set rngDC = .Range("A1:A750").Find(DistrictCode, LookIn:=xlValues)
Set rngRK = .Range("A5:DI5").Find(Refkey, LookIn:=xlValues)

ie: rngDC is finding my code ('010100', Cell:A2) but not setting the range as A2:DI2. rngRK is finding my refkey ('25478', Cell:C1) but not setting the range as C1:C750.

I believe if I solve this dilemma and set the ranges, the Intersect will work and find the cell I want (Cell:C2).

Thanks,
 
Upvote 0
The correct CALL is
Call GetData(nrow, DistrictCode, Year)

GetDataTest was my test Sub using the Intersect code from above.
 
Upvote 0

Forum statistics

Threads
1,215,706
Messages
6,126,336
Members
449,310
Latest member
zztt388

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top