VBA Code improvement

[Robert.Bristow]

Hello,

I am looking for advise on how to write a macro more efficiently. Being that the following macro was my first attempt at VBA I am more than pleased that it actually works but now I need to complete another project that will use almost the same code and I would like to make it cleaner if possible.

I cannot supply a copy of the spreadsheet as it contains PHI, but what this code is doing is combining an SSN with a relationship code and searching for that combination on a separate tab. If found it applies the name of the person to the specified cell. The code loops until it runs out of SSN's. The last 6 formulas are pulling in the person's address and client number. The over all result is that a vertical list of members (every one in our data base) is converted to a horizontal list of family members (only those as identified by SSN and relationship codes as needing letters). This data is then used as mail merge data for a variety of letters.

In the first row of the formulas I have used red text on the variables that required me to produce so many lines of code. I feel that there should be a way to code those 2 variables to work off a repeating calculation verses 20 separate static formulas but it seems to be a little past my skill level to figure out.


Sub MbrSearch()
Dim MbrMark As Integer
Dim row As Integer

' MbrSearch Macro
'
row = 2

Range("B2").Select
Do Until Selection.Value = ""
Range("v" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,1,1)),MILData!C2:C9,2,FALSE)"
Range("w" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,2,1)),MILData!C2:C9,2,FALSE)"
Range("x" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,3,1)),MILData!C2:C9,2,FALSE)"
Range("y" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,4,1)),MILData!C2:C9,2,FALSE)"
Range("z" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,5,1)),MILData!C2:C9,2,FALSE)"
Range("aa" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,6,1)),MILData!C2:C9,2,FALSE)"
Range("ab" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,7,1)),MILData!C2:C9,2,FALSE)"
Range("ac" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,8,1)),MILData!C2:C9,2,FALSE)"
Range("ad" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,9,1)),MILData!C2:C9,2,FALSE)"
Range("ae" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,10,1)),MILData!C2:C9,2,FALSE)"
Range("af" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,11,1)),MILData!C2:C9,2,FALSE)"
Range("ag" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,12,1)),MILData!C2:C9,2,FALSE)"
Range("ah" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,13,1)),MILData!C2:C9,2,FALSE)"
Range("ai" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,14,1)),MILData!C2:C9,2,FALSE)"
Range("aj" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,15,1)),MILData!C2:C9,2,FALSE)"
Range("ak" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,16,1)),MILData!C2:C9,2,FALSE)"
Range("al" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,17,1)),MILData!C2:C9,2,FALSE)"
Range("am" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,18,1)),MILData!C2:C9,2,FALSE)"
Range("an" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,19,1)),MILData!C2:C9,2,FALSE)"
Range("ao" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,20,1)),MILData!C2:C9,2,FALSE)"
Range("ap" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,1,1)),MILData!C2:C9,3,FALSE)"
Range("aq" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,1,1)),MILData!C2:C9,4,FALSE)"
Range("Ar" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,1,1)),MILData!C2:C9,5,FALSE)"
Range("As" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,1,1)),MILData!C2:C9,6,FALSE)"
Range("At" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,1,1)),MILData!C2:C9,7,FALSE)"
Range("Au" & row).FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,1,1)),MILData!C2:C9,8,FALSE)"


row = row + 1
Range("b" & row).Select
Loop

Application.Run "FormatList"
End Sub



Thanks in advance for any advise.

Robert Bristow
Bothell WA

 

[mikerickson]

One could alter the formula slightly and use code like this.

With Range("b2")
    With Range(.Cells, .End(xlDown))
        With Application.Intersect(.EntireRow, .Parent.Range("V:Ao"))
           .FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,Columns(RC" & .Column & ":RC),1)),MILData!C2:C9,2,FALSE)"
            With .Offset(0, .Columns.Count).Resize(, 6)
                .FormulaR1C1 = "=VLOOKUP(RC2&(MID(RC7,1,1)),MILData!C2:C9,COLUMNS(RC" & .Column & ":RC[2]),FALSE)"
            End With
        End With
    End With
End With

 

[Robert.Bristow]

Code worked like a charm. Not only written more efficiently but it also processes about 6 times faster. Many thanks for such a fast and accurate response.

Robert Bristow