Rearranging cells to create a organized database

[nikobaresi]

[TABLE="width: 400"]
<colgroup><col span="5"></colgroup><tbody>[TR]
[TD="colspan: 5"]Hi, I'm starting to work in a project and I know a little of BA, but I really need to do this macro in order to save hours of work a week. So I'm really thankful if someone can help me.[/TD]
[/TR]
[TR]
[TD="colspan: 5"]I have to analyze some data from the prices of food. Week to week I get a table similar to the first one, but in order to work with it I have to transform it into the second table. [/TD]
[/TR]
[TR]
[TD="colspan: 5"]The process I've think of is to insert a column in the left of the table 1. Then The macro has to identify each bold cel in the column "b" (because only the products have bold letter) with an indexed loop, and (considering the product that the macro found with bold letter is now in the cell (2,i)), copy that product in the cell (1, i+1) and and drag down this name til the en of the table; and the repeat this process until the last product. Finally it is necesarry to delete all the rows of the products in column 2 (but that's the part I know How to solve).[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 5"]As week to week the tables can have different number of rows per product it is necesary to make the process of indexing the cells.[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][TABLE="width: 100"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]MAX PRICE[/TD]
[TD]MIN PRICE[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Carrots[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]NY[/TD]
[TD]1,4[/TD]
[TD]1,4[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]DC[/TD]
[TD]1,3[/TD]
[TD]1,1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]LA[/TD]
[TD]1,1[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Bo[/TD]
[TD]1,3[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Tomato[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]DC[/TD]
[TD]5,8[/TD]
[TD]5,7[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]LA[/TD]
[TD]5,9[/TD]
[TD]5,85[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Bo[/TD]
[TD]6[/TD]
[TD]5,85[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Rice[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]NY[/TD]
[TD]2,7[/TD]
[TD]2,5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Phil[/TD]
[TD]2,3[/TD]
[TD]2,2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Lettuce[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]LA[/TD]
[TD]2,5[/TD]
[TD]2,3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Bo[/TD]
[TD]2,5[/TD]
[TD]2,3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Phil[/TD]
[TD]2,4[/TD]
[TD]2,2[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]
[TABLE="width: 100"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD]MAX PRICE[/TD]
[TD]MIN PRICE[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Carrots[/TD]
[TD]NY[/TD]
[TD]1,5[/TD]
[TD]1,4[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Carrots[/TD]
[TD]DC[/TD]
[TD]1,3[/TD]
[TD]1,1[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Carrots[/TD]
[TD]LA[/TD]
[TD]1,1[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Carrots[/TD]
[TD]Bo[/TD]
[TD]1,3[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Tomato[/TD]
[TD]DC[/TD]
[TD]5,8[/TD]
[TD]5,7[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Tomato[/TD]
[TD]LA[/TD]
[TD]5,9[/TD]
[TD]5,85[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Tomato[/TD]
[TD]Bo[/TD]
[TD]6[/TD]
[TD]5,85[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Rice[/TD]
[TD]NY[/TD]
[TD]2,7[/TD]
[TD]2,5[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Rice[/TD]
[TD]Phil[/TD]
[TD]2,3[/TD]
[TD]2,2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Lettuce[/TD]
[TD]LA[/TD]
[TD]2,5[/TD]
[TD]2,3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Lettuce[/TD]
[TD]Bo[/TD]
[TD]2,5[/TD]
[TD]2,3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Lettuce[/TD]
[TD]Phil[/TD]
[TD]2,3[/TD]
[TD]2,2[/TD]
[/TR]
</tbody>[/TABLE]

[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]

 

[excelginge]

Hi nikobaresi,

Not sure if this will do but much easier to add a worksheet and put results into there.

Code Below

Sub makeNewSheet()




Dim wsS As Excel.Worksheet
Dim wsT As Excel.Worksheet
Dim lngMaxRow As Long
Dim i As Long
Dim ii As Long
Dim strCat As String

strCat = "RubbishStuff" 'as a default

Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Results").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set wsS = ActiveWorkbook.ActiveSheet
Set wsT = Worksheets.Add(After:=wsS)

wsT.Name = "Results"

wsT.Range("A1").Value = "Product"
wsT.Range("B1").Value = "Area"
wsT.Range("C1").Value = "MAX PRICE"
wsT.Range("D1").Value = "MIN PRICE"
ii = 2
lngMaxRow = wsS.Range("A65536").End(xlUp).Row

For i = 2 To lngMaxRow
If wsS.Range("A" & i).Font.Bold = True Then
strCat = wsS.Range("A" & i).Value
Else
wsT.Range("A" & ii) = strCat
wsT.Range("A" & ii).Font.Bold = True
wsT.Range("A" & ii).Offset(0, 1) = wsS.Range("A" & i).Offset(0, 0)
wsT.Range("A" & ii).Offset(0, 2) = wsS.Range("A" & i).Offset(0, 1)
wsT.Range("A" & ii).Offset(0, 3) = wsS.Range("A" & i).Offset(0, 2)
wsT.Range("A" & ii).Offset(0, 4) = wsS.Range("A" & i).Offset(0, 3)
ii = ii + 1
End If
Next i


Set wsS = Nothing
Set wsT = Nothing
End Sub

 

[excelginge]

Hi nikobaresi,

For information when running the process the active sheet should be the file information you receive.

Enjoy

ExcelGringe