List system, need VBA code assistans

[fstormby]

Hi,

I'm working on a data sheet/equipment list system for my business and need VBA code to minimize the filesize. For now i have two separate things i need help with:

1.
I use a Table with 38 Columns to input my data. I want to have a button that adds a row to the bottom of the column with the same functions as the cells above. I also want a delete button that simply deletes rows from the bottom.

2.
As described above i have my data input table that changes alot (rows only, colums will not change).
The first three columns have the headers 1# (row number), 2Color, 3Position.
The other 35 columns are divided in 7 categories, all with 5 columns in each.
Example:
(Category 1) 1-No, 1-Type, 1-Note, 1-Cat., 1-Kg(Category 2) 2-No, 2-Type, 2-Note, 2-Cat., 2-Kg........

What i need is a VBA code that instantly in a separate sheet "stack" the data from the 7 different categories after each other under the column headers Color, Position, No, Type, Note, Cat, Kg. For each new category columns Color, Position starts from the top again.

The idea is to input data in the Table wich mostly is designed to generate a good overview.That's what the 7 categories are for, and then interactivly collect the data to one long "total" table in another sheet and use that data for a pivot table that only have one "No", "Type", etc...
I'm using Excel 2011, Mac version

Hope this is understandable, looking forward for your inputs...

Best regards,
Fredrik

 

[Andrew Fergus]

Hello and welcome to MrExcel!

At this stage I'm going to focus on the part of your question that seeks to re-layout the data such that you go from 38 columns on your data sheet, to something that has 8 columns on the sheet you wish to use for the pivot table.

I have provided a formula solution - this could be done with VBA but when you mentioned Mac I thought I might go for a formula solution. I have assumed the data headings are in cells A1:AL1 and the data starts at row 2 on a sheet called 'Data'.

Copy the following formula onto a new sheet into cell A2 (in the same workbook) :
=INDEX(Data!$A:$AL,2+TRUNC((ROW(B2)-2)/7),COLUMN(A$1)+((COLUMN(A$1)>3)*(5*MOD(ROW($A2)-2,7))))

If you copy this formula across to column H, and down as many rows as you want, then the data will appear in a columnar format so that you can either use it for a pivot table, or use the auto-filter options.

Please note the asssumption regarding the data starting in row 2 and the list also starting in row 2 is crucial for this solution to work. How many rows of data do you currently have?

Andrew

 

[fstormby]

Andrew,
Thanks for your advice. I did sort it out with the following code:

Sub COPYDATA()

Application.ScreenUpdating = False

Range("A2:H1048576").Select
Selection.Clear
Range("A2").Select
Sheets("EQUIPMENT SETUP").Range("Tabell1").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("C1048576").End(xlUp).Offset(1, 0).Select
Sheets("EQUIPMENT SETUP").Range("Tabell2").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("C1048576").End(xlUp).Offset(1, 0).Select
Sheets("EQUIPMENT SETUP").Range("Tabell3").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("C1048576").End(xlUp).Offset(1, 0).Select
Sheets("EQUIPMENT SETUP").Range("Tabell4").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range("C1048576").End(xlUp).Offset(1, 0).Select
Sheets("EQUIPMENT SETUP").Range("Tabell5").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

Range("C1048576").End(xlUp).Offset(1, 0).Select
Sheets("EQUIPMENT SETUP").Range("Tabell6").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

Range("C1048576").End(xlUp).Offset(1, 0).Select
Sheets("EQUIPMENT SETUP").Range("Tabell7").Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select

Application.ScreenUpdating = True

End Sub

Tips & tricks to improve the code is welcome, total newbie so i'm just glad it works...

Best regards,
Fredrik