0

I am trying to do the following (please see the picture below): I have N categories in a worksheet (below just showing 2 as example), having 5 subcategories each category and I want to copy them in another worksheet but having only the subcategories, listing all the data from categories one below the others. How can I do that in VBA?

enter image description here

The code I am using so far :

    Sub Fill_Tracker()

    ' Initialize the worksheets, number of rows per Offer and numbers of Offers
    Dim WSS As Worksheet
    Dim WSD As Worksheet
    Set WSS = Sheets("Database")
    Set WSD = Sheets("Data_PIVOT")
' Copy and paste values of Currency BOQ
    WSS.Range("B10", WSS.Range("b10").End(xlDown)).Copy
    WSD.Range("J2").PasteSpecial xlPasteValues
    ' Copy and paste values of USD
    WSS.Range("c10", WSS.Range("c10").End(xlDown)).Copy
    WSD.Range("k2").PasteSpecial xlPasteValues
    ' Copy and paste values of USD/Wdc
    WSS.Range("d10", WSS.Range("d10").End(xlDown)).Copy
    WSD.Range("l2").PasteSpecial xlPasteValues
    ' Copy and paste values of Rate
    WSS.Range("e10", WSS.Range("e10").End(xlDown)).Copy
    WSD.Range("m2").PasteSpecial xlPasteValues
    ' Copy and paste values of Description
    WSS.Range("f10", WSS.Range("f10").End(xlDown)).Copy
    WSD.Range("n2").PasteSpecial xlPasteValues

Thanks for all the help.

Alessandro Peticchia
  • 47
  • 1
  • 1
  • 4
  • You should provide the code you've tried, and focus your question. Right now this kinda looks like *develop something for me and for free*. Please, show some effort and were are you stuck, and what errors are you getting. – Foxfire And Burns And Burns Jan 28 '21 at 10:44
  • Hi, this is actually just a small part of a bigger code. Anyway I am able to do just the first step of what I am asking and I suppose I'll need to use a for loop to continue...and that's where I can't continue. I'll include the code. – Alessandro Peticchia Jan 28 '21 at 10:48
  • 1
    Then, edit your question and show us that "first step". We maybe will understand how these "categories" can be identified. Are all of them formed by 5 consecutive columns? Is their name in a merged range containing the column belonging to it? Are the columns those so named 'subcategories'? Or how else? Do all categories have the same number of rows? Is there a fix number of categories, or the range is dinamic? – FaneDuru Jan 28 '21 at 10:52
  • @AlessandroPeticchia May you please edit your image and show the columns headers and row numbers? That way we can understand better your code and see exactly what it does (so B10 is what cell?) – Foxfire And Burns And Burns Jan 28 '21 at 10:54
  • Edited. The categories are part of a database. They will be added overtime (just as being a new supplier with subcategories such costs per activities supplied/performed or delivery time etc..). The categories are potentially infinite and formed by 5 consecutive columns. Yes the name is in a Merged range. – Alessandro Peticchia Jan 28 '21 at 10:55
  • Are the categories name on the first sheet row? – FaneDuru Jan 28 '21 at 10:56
  • @FoxfireAndBurnsAndBurns the image was just an example...that is not the real file. I'll try to share it if I can (it contains some personal info). thanks – Alessandro Peticchia Jan 28 '21 at 10:56
  • @FaneDuru yes they are – Alessandro Peticchia Jan 28 '21 at 10:57
  • @AlessandroPeticchia We do not need real info, data can be fake, but position of each data should be true.So it's easier to understand code (and to post an answer) – Foxfire And Burns And Burns Jan 28 '21 at 10:58
  • You did not answer, or I missed it if all categories have **the same number of rows**... – FaneDuru Jan 28 '21 at 11:08
  • @FaneDuruI think all categories got same headers and same number of **columns**, but different number of rows, and he wants to merge all of it. That's why I asked OP some fake data and also header columns and row numbers, because the code does not make really sense. But this is just a shot in the dark. – Foxfire And Burns And Burns Jan 28 '21 at 11:41
  • 1
    @Foxfire And Burns And Burns: Since he did not supply an answer, from this point of view, I supplied a piece of code solving (in a very fast way) the problem for different number of rows. With the same number, the solution I had in my mind should be simpler... – FaneDuru Jan 28 '21 at 11:44

1 Answers1

1

Please, try the next code. It should be very fast for a big range. It avoids iteration between each row, it uses arrays and array slices:

Sub Fill_Tracker()
    Dim WSS As Worksheet, WSD As Worksheet, lastRow As Long, lastCol As Long, lastR As Long
    Dim arr, arrCateg, strC As String, strCol As String, i As Long, lastRWSD As Long, c As Long
    
    Set WSS = Sheets("Database")
    Set WSD = Sheets("Data_PIVOT")
    lastRow = WSS.UsedRange.Rows.count 'maximum number of rows to be processed
    lastCol = WSS.cells(2, WSS.Columns.count).End(xlToLeft).Column 'no of columns
    lastRWSD = WSD.Range("A" & WSD.Rows.count).End(xlUp).row + 1   'last empty row
       
    arr = WSS.Range("A3", WSS.cells(lastRow, lastCol)).Value 'put the sheet content in an array
    c = 5  'a variable to increment in order to build the column to be copied headers
    For i = 1 To UBound(arr, 2) Step 5
        strC = Split(cells(1, i).Address, "$")(1)                  'first column letter
        strCol = strC & ":" & Split(cells(1, c).Address, "$")(1)   'string of involved columns letter
        lastR = WSS.Range(strC & WSS.Rows.count).End(xlUp).row - 2 'last row for the above range
        
        c = c + 5 'increment the columns range
        'make a slice for the necessary array rows and columns!
        arrCateg = Application.index(arr, Evaluate("row(1:" & lastR & ")"), Evaluate("COLUMN(" & strCol & ")"))
        'drop the array at once:
        WSD.Range("A" & lastRWSD).Resize(UBound(arrCateg), 5).Value = arrCateg
        lastRWSD = WSD.Range("A" & WSD.Rows.count).End(xlUp).row + 1 'last row where next time the array will be dropped
    Next
End Sub
FaneDuru
  • 38,298
  • 4
  • 19
  • 27
  • @Alessandro Peticchia: Didn"t you find some time to test the above code? If tested, doesn't it work as you need? – FaneDuru Jan 28 '21 at 13:23
  • + further reading: [Some pecularities of the `Application.Index()` function](https://stackoverflow.com/questions/51688593/excel-vba-insert-new-first-column-in-datafield-array-without-loops-or-api-call/51714153#51714153) – T.M. Jan 28 '21 at 18:43
  • 1
    @T.M.: Thanks! I could see that thread some time ago. One of the up votes is mine... I also followed the posted links and I must confess that I tried using of `Evaluate` in case of discontinuous columns range (instead of `buildColAr)` and I couldn't find a way... This should be a **real challenge**. :) Something tells me that it should be possible, only I couldn't do it... – FaneDuru Jan 29 '21 at 08:15
  • hi @FaneDuru ...I am not an expert so it's quite difficult for me to understand your code. In any case I did implemented it and even if it works it doesn't produce the result I want. Actually it does nothing....probably it's my fault because I did not share the exact excel file I am working on... – Alessandro Peticchia Jan 29 '21 at 11:23
  • @Alessandro Peticchia: No need to be an expert to run it... So, let us take it step by step: Do you have two such sheets, named as you used them in your code? Anyhow, can you share the workbook in discussion? You can use [this](https://easyupload.io/) transfer site. It is free and easy to be used... – FaneDuru Jan 29 '21 at 11:28
  • @Alessandro Peticchia: Do you intend to appear here maximum one time per day? If yes, this is not the most appropriate way to stimulate us in order to help you. When somebody spends some time only to solve your problem, it is at least polite to check your question and do something for helping to be helped... – FaneDuru Jan 29 '21 at 14:12