excelvbaspreadsheetindex-match

how copy specific cells from one worksheet to another, on varying rows with spaces. Somehow use index match?

I have a worksheet with three tabs. Client facing 'Form", "List" to paste in CRM extracted information, and "Data" to house any needed interim data.

The pertinent information extracted from the CRM is two columns, Column A the 'Regions' and Column C the 'Item Names'.

I want to use VBA code to take the information from "List" and display it on "Form" with the Region Name then in the same column list the items for that region. Leave a space and continue.

Example:

Airport
Toy Robot
Uno Card Game

Commercial
Dinosaur Figures
Glass Marbles
Kids Makeup Kit
Lego Bricks
Nerf Gun
PlayDoh Can
PlayDoh Toolkit

Residential
Deck Of Cards
Dino Egg
Dinosaur Figures
Glass Marbles
Kids Makeup Kit
Lego Bricks
Mini Ping Pong
Monopoly

Downtown
Lego Bricks
Nerf Gun
PlayDoh Can

What I want the end result to look like

I've used VBA code for figure out how many items are listed for each region and store that in tab "Data". Column A for the region and Column B for the number of items listed for that region.

For sample: Airport 2 Commercial 7 Residential 8 Downtown 3

Next I have code that setups the Region Names, leaving space for the Items.

Airport

Commercial

Residential

Downtown

What I have so far

Now I'm trying to figure out how to add the accompanying Item Names under each Region on tab "Form".

I've tried using Index Match with a loop, but it's not looping the right amount of times, nor taking the empty rows into consideration.

Solution

  • This code works in my sample file if i run it in sheet "Form". The data entry in sheet "Form" starts in cell A10 and there is no data in sheet "Form" when the macro is started. Like in your example the data is sorted in sheet "List". The code works as well if there is only one entry for a region.

    Sub regions()

Dim i, j, l, m As Long

Range("A:A").Clear

j = 10

For i = 2 To Worksheets("List").Range("A" & Rows.Count).End(xlUp).Row

 l = Application.WorksheetFunction.CountIf _
 (Worksheets("List").Range("A:A"), Worksheets("List").Cells(i, 1))


  If l = 1 Then
       Cells(j, 1).Value = Worksheets("List").Cells(i, 1).Value
       Cells(j + 1, 1).Value = Worksheets("List").Cells(i, 3).Value
    j = j + l + 2
 Else



  If Worksheets("List").Cells(i, 1).Value = _
  Worksheets("List").Cells(i + 1, 1).Value And _
Application.WorksheetFunction.CountIf(Range("A:A"), _
Worksheets("List").Cells(i, 1)) = 0 Then




    Cells(j, 1).Value = Worksheets("List").Cells(i, 1).Value
    
    For m = 1 To l
    Cells(j + m, 1).Value = Worksheets("List").Cells(i + m - 1, 3).Value
    Next m
    
    j = j + l + 2
 

Else

End If

End If

Next i

End Sub