joe
joe

Reputation: 1

How to hlookup from one worksheet to another and repeat for multiple rows

I have a worksheet (sheet 1) with 272 districts (column D4:D275) and each row has 11 categories (category names E3:O3) (See image 1):

https://i.sstatic.net/mFnaf.png

I need to rearrange this data (in sheet 2) so that each category has its own row (ie 272*11 rows altogether). (See image 2):

https://i.sstatic.net/wvfXS.png

I know this requires hlookup but I don't know how to write the VBA code for it. Please can somebody tell me what the code I require is and explain what each step does as I will have to do this on a number of different documents so will need to know how to adjust the code.

Let me know if more info is needed

Thanks a lot!

Upvotes: 0

Views: 940

Answers (4)

Mrig
Mrig

Reputation: 11712

Well, there are number of ways of achieving what you are trying to accomplish.

1. Using formula

In Cell A4 of Sheet2 enter the following formula and drag/copy down as required

=OFFSET(Sheet1!$D$4,FLOOR((ROW(Sheet1!D4)-ROW(Sheet1!$D$4))/11,1),0)

In Cell C4 of Sheet2 enter the following formula and drag/copy down as required

=OFFSET(Sheet1!$E$4,FLOOR((ROW(Sheet1!E4)-ROW(Sheet1!$E$4))/11,1),MOD(ROW(Sheet1!D4)-ROW(Sheet1!$D$4),11))

2. Using VBA

Method I - Calculate values from Sheet1 and update the range in Sheet2

Sub Demo1()
    Dim srcWB As Workbook
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim lastRow As Long, lastCol As Long, i As Long, CategoryCnt As Long, temp

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set srcWB = ThisWorkbook
    Set srcWS = srcWB.Sheets("Sheet1")
    Set destWS = srcWB.Sheets("Sheet2")
    CategoryCnt = 11    '->enter number of categories
    lastRow = srcWS.Cells(Rows.Count, "D").End(xlUp).Row    '->last row with data
    lastCol = srcWS.Cells(3, Columns.Count).End(xlToLeft).Column    '->last column with data

    For i = 4 To (lastRow - 4) * CategoryCnt
        destWS.Cells(i, 1) = srcWS.Cells(Int((i - 4) / CategoryCnt) + 4, 4)
        destWS.Cells(i, 3) = srcWS.Cells(Int((i - 4) / CategoryCnt) + 4, ((i - 4) Mod CategoryCnt) + 5)
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Method II - Enter formula in Sheet2 range

Sub Demo2()
    Dim srcWB As Workbook
    Dim srcWS As Worksheet, destWS As Worksheet
    Dim lastRow As Long, lastCol As Long, i As Long, CategoryCnt As Long, temp

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Set srcWB = ThisWorkbook
    Set srcWS = srcWB.Sheets("Sheet1")
    Set destWS = srcWB.Sheets("Sheet2")
    CategoryCnt = 11
    lastRow = srcWS.Cells(Rows.Count, "D").End(xlUp).Row
    lastCol = srcWS.Cells(3, Columns.Count).End(xlToLeft).Column

    destWS.Range("A4").Formula = "=OFFSET(Sheet1!$D$4,FLOOR((ROW(Sheet1!D4)-ROW(Sheet1!$D$4))/11,1),0)"
    destWS.Range("C4") = "=OFFSET(Sheet1!$E$4,FLOOR((ROW(Sheet1!E4)-ROW(Sheet1!$E$4))/11,1),MOD(ROW(Sheet1!D4)-ROW(Sheet1!$D$4),11))"
    Range("A4:C4").Select
    Selection.AutoFill Destination:=destWS.Range("A4:C" & (lastRow - 4) * 11), Type:=xlFillDefault

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Let me know if anything is not clear.

See image for reference:

Sheet1

enter image description here

Sheet2

enter image description here

Upvotes: 0

Karthick Gunasekaran
Karthick Gunasekaran

Reputation: 2713

Try with below. Kindly alter

Sub test()
    Dim r As Range
    Dim incre As Long
    Dim distr As String
    Set r = Range("D4:K6")
    incre = 4
    incre2 = 4
    For Each cell In r
        If cell Like "District*" Then
            distr = cell.Value
        Else
            Range("B" & incre).Value = cell.Value
            Range("A" & incre).Value = distr
            incre = incre + 1
        End If
    Next
End Sub

enter image description here

Upvotes: 0

Arun Thomas
Arun Thomas

Reputation: 845

based on the screenshots attached, this will do the job which will add the values respectively in the Columns A, B and C

Count = 4

For i = 4 To 18
    For j = 5 To 15
        Cells(Count, 1).Value = Cells(i, 4).Value
        Cells(Count, 2).Value = Cells(i, j).Value
        Cells(Count, 3).Value = Cells(3, j).Value
        Count = Count + 1
    Next j
Next i

Upvotes: 1

Sumeet Gupta
Sumeet Gupta

Reputation: 198

If you know the formula you are supposed to be using on screen, the same forumla can be used through VBA macro code by using Application.WorksheetFunction

=VLOOKUP(XXXX)

can be written in Macro as

Application.WorksheetFunction.VLookup(XXXX)

Hope this helps.

Upvotes: 0

Related Questions