Rearranging cells to create a organized database

nikobaresi

New Member
Joined
Oct 22, 2015
Messages
4
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.
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.
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).
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.
ABC
1MAX PRICEMIN PRICE
2Carrots
3NY1,41,4
DC1,31,1
LA1,11
Bo1,31
Tomato
DC5,85,7
LA5,95,85
Bo65,85
Rice
NY2,72,5
Phil2,32,2
Lettuce
LA2,52,3
Bo2,52,3
Phil2,42,2

<tbody>
</tbody>

ABCD
1MAX PRICEMIN PRICE
1CarrotsNY1,51,4
2CarrotsDC1,31,1
3CarrotsLA1,11
CarrotsBo1,31
TomatoDC5,85,7
TomatoLA5,95,85
TomatoBo65,85
RiceNY2,72,5
RicePhil2,32,2
LettuceLA2,52,3
LettuceBo2,52,3
LettucePhil2,32,2

<tbody>
</tbody>


<colgroup><col span="5"></colgroup><tbody>
</tbody>
 

excelginge

Board Regular
Joined
Sep 19, 2015
Messages
80
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

Board Regular
Joined
Sep 19, 2015
Messages
80
Hi nikobaresi,

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

Enjoy

ExcelGringe
 

Forum statistics

Threads
1,082,257
Messages
5,364,074
Members
400,778
Latest member
Canadian Sal

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top