Reputation: 1
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
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
Sheet2
Upvotes: 0
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
Upvotes: 0
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
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