VBA loop using index and match with columns and rows.

[JulezWheeler]

Hi All

I am writing a code in VBA to index and match against a date which runs in each column, and returns down each row. I can do this for each row if i write it for each as attached, is there a easier way so that it loops rather than me having to write multiple macros?

'''

Sub test2()

Dim ws As Worksheet
Set ws = Sheet2
Dim db As Workbook
Dim x As Long, i As Long

Set db = Workbooks.Open("C:\Users\*****\Desktop\MP Database\Data.xlsx")

With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
ws.Range("N4") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C17:ZZ17"),
WorksheetFunction.Match(ws.Range("n2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N5") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C18:ZZ18"),
WorksheetFunction.Match(ws.Range("n2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N6") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C19:ZZ19"),
WorksheetFunction.Match(ws.Range("n2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N7") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C20:ZZ20"),
WorksheetFunction.Match(ws.Range("n2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N8") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C21:ZZ21"),
WorksheetFunction.Match(ws.Range("n2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N9") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C22:ZZ22"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N10") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C23:ZZ23"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N11") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C24:ZZ24"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N12") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C25:ZZ25"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N13") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C26:ZZ26"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N14") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C27:ZZ27"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N15") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C28:ZZ28"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N16") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C29:ZZ29"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N17") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C30:ZZ30"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N18") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C31:ZZ31"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))
ws.Range("N19") = WorksheetFunction.Index(db.Worksheets("HM MWh").Range("C32:ZZ32"),
WorksheetFunction.Match(ws.Range("N2"), db.Worksheets("HM MWh").Range("C4:zz4"), 0))


With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = True
End With


End Sub
'''

 

[SidharthS]

Can u upload an excel example?

 

[dmt32]

Hi
welcome to forum
I have only glanced at your code & following not tested but see if this helps you

Sub test2()
   
    Dim ws              As Worksheet, wsHM_MWh As Worksheet
    Dim wbDB            As Workbook
    Dim r               As Long
   
    Const strFileName   As String = "C:\Users\*****\Desktop\MP Database\Data.xlsx"
   
    Set ws = Sheet2
   
    EventsEnable False
   
    Set wbDB = Workbooks.Open(strFileName, 0, True)
    Set wsHM_MWh = wbDB.Worksheets("HM MWh")
   
    For r = 4 To 19
        ws.Cells(r, "N") = WorksheetFunction.Index(wsHM_MWh.Range("C" & r + 13 & ":ZZ" & r + 13), _
                           WorksheetFunction.Match(ws.Range("N2"), wsHM_MWh.Range("C4:zz4"), 0))
    Next r
   
    wbDB.Close False
    EventsEnable True

End Sub

Sub EventsEnable(ByVal State As Boolean)
    With Application
        .ScreenUpdating = State: .EnableEvents = State
        .CutCopyMode = State
        .Calculation = IIf(State, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

Dave

 

[JulezWheeler]

Many thanks for this Dave, i have just tried it and it works, perfectly.

 

[dmt32]

Many thanks for this Dave, i have just tried it and it works, perfectly.

most welcome & appreciate feedback

Dave