How to stack up excel rows to column(s)? [as shown below] [duplicate] - excel

This question already has answers here:
excel vba I need to transpose data from columns to rows
(2 answers)
Closed 5 years ago.
I have a dataset with 50,000 records. The format is like shown below.
Category | A | B | C
---------|-----|-----|-----
X | 100 | 120 | 150
Y | 200 | 220 | 250
Z | 300 | 320 | 350
I want the resulting table to look like the one shown below.
Category | Type | price
---------|------|-----
X | A | 100
X | B | 120
X | C | 150
---------|------|----
Y | A | 200
Y | B | 220
Y | C | 250
---------|------|----
Z | A | 300
Z | B | 320
Z | C | 350
How can I do this in MS Excel?

hope this will help you ;)
Public Type res
cat As String
mtype As String
price As Long
End Type
Sub arranger()
'defs+inits
Set src = Sheets("src")
Set res = Sheets("result")
Dim mydatas() As res
lastrow = src.Cells(1, 1).End(xlDown).Row
'just for safe :)
If lastrow > 65000 Then Exit Sub
ReDim mydatas(2 To lastrow * 3)
act = 2
'fill array
For actrow = 2 To lastrow
For col = 2 To 4
mydatas(act).cat = src.Cells(actrow, 1)
mydatas(act).mtype = src.Cells(1, col)
mydatas(act).price = src.Cells(actrow, col)
act = act + 1
Next col
Next actrow
'write back in new format
'headers
res.Cells(1, 1) = "Cat"
res.Cells(1, 2) = "Type"
res.Cells(1, 3) = "price"
'datas
For act = 2 To UBound(mydatas) - 2
res.Cells(act, 1) = mydatas(act).cat
res.Cells(act, 2) = mydatas(act).mtype
res.Cells(act, 3) = mydatas(act).price
Next act
End Sub

Related

remove duplicates but retain the first position in excel vba macro

I am looking to remove duplicate rows but leave the first line
Using vba macros in excel 2010.
This is the initial information
A | B
1. A | 1
2. A | 1
3. A | 1
4. A | 1
5. B | 2
6. B | 2
7. B | 2
after running the macro
A | B
1. A | 1
2. | 1
3. | 1
4. | 1
5. B | 2
6. | 2
7. | 2
Can you help me,please!
Not elegant, but quick and dirty:
Dim iLastRow As Integer
iLastRow = 13
Range("h1:h" & iLastRow).Formula = "=if(countif(a$1:a1,a1)>1,"""",a1)"
Range("a1:a" & iLastRow).Value = Range("h1:h" & iLastRow).Value
Range("h1:h" & iLastRow).Clear

Splitting rows that contain a list of postcode prefixes into multiple rows, based on postcode area

I have a table with several columns of data, one of which contains a list of different combined postcode prefixes on the same row.
Here's an example of the table layout:
+------+-----------------------------+
| Col1 | Col2 |
+------+-----------------------------+
| a | AB10; AB11; DD10; DD9 |
| b | S5; SS7; AA1; AA4 |
| c | AB33; AB34; AB36; GG10; GS9 |
+------+-----------------------------+
I'm looking to split the postcode prefixes into multiple rows, based on the area of the postcode, as below:
+------+------------------+
| Col1 | Col2 |
+------+------------------+
| a | AB10; AB11 |
| a | DD10; DD9 |
| b | S5 |
| b | SS7 |
| b | AA1; AA4 |
| c | AB33; AB34; AB36 |
| c | GG10 |
| c | GS9 |
+------+------------------+
I've found a VBA solution that splits, using the semicolon as a delimiter, but not how I need it done.
Sub splitByColB()
Dim r As Range, i As Long, ar
Set r = Worksheets("Sheet1").Range("B4").End(xlUp)
Do While r.Row > 1
ar = Split(r.Value, ";")
If UBound(ar) >= 0 Then r.Value = ar(0)
For i = UBound(ar) To 1 Step -1
r.EntireRow.Copy
r.Offset(1).EntireRow.Insert
r.Offset(1).Value = ar(i)
Next
Set r = r.Offset(-1)
Loop
End Sub
I could import the table in SQLExpress, so an SQL solution would also be welcome.
The SQL solution I put together uses a T-SQL function called DelimitedSplit8K which works like the VB SPLIT function you are using.
-- Sample Data
DECLARE #table TABLE (Col1 CHAR(1) UNIQUE, Col2 CHAR(200));
INSERT #table (Col1,Col2) VALUES ('a','AB10; AB11; DD10; DD9'),
('b','S5; SS7; AA1; AA4'),('c','AB33; AB34; AB36; GG10; GS9');
WITH xx(Col1,i,Pre) AS
(
SELECT t2.Col1, ss.Item+'', f.Pre
FROM #table AS t2
CROSS APPLY dbo.DelimitedSplit8K(t2.Col2,';') AS s
CROSS APPLY (VALUES(RTRIM(LTRIM(s.item)))) AS ss(Item)
CROSS APPLY (VALUES(SUBSTRING(ss.Item,0,PATINDEX('%[0-9]%',ss.Item)))) AS f(Pre)
)
SELECT xx.col1, col2 = STUFF((SELECT '; '+i
FROM xx AS x2
WHERE x2.Col1 = xx.Col1 AND x2.Pre = xx.Pre
FOR XML PATH('')),1,2,'')
FROM xx
GROUP BY col1, xx.Pre;
Returns:
col1 Col2
---- ----------------------
a AB10; AB11
a DD10; DD9
b AA1; AA4
b S5
b SS7
c AB33; AB34; AB36
c GG10
c GS9
I also put together a solution that works with SQL Server 2017 which is cleaner (in case you upgrade or others or using 2017.)
-- Sample Data
DECLARE #table TABLE (Col1 CHAR(1) UNIQUE, Col2 CHAR(200));
INSERT #table (Col1,Col2) VALUES ('a','AB10; AB11; DD10; DD9'),
('b','S5; SS7; AA1; AA4'),('c','AB33; AB34; AB36; GG10; GS9');
SELECT t.Col1, split.item
FROM #table AS t
CROSS APPLY
(
SELECT STRING_AGG(ss.Item,'; ') WITHIN GROUP (ORDER BY ss.Item)
FROM #table AS t2
CROSS APPLY STRING_SPLIT(t2.Col2,';') AS s
CROSS APPLY (VALUES(TRIM(s.[value]))) AS ss(Item)
WHERE t.Col1 = t2.col1
GROUP BY SUBSTRING(ss.Item,0,PATINDEX('%[0-9]%',ss.Item))
) AS split(item);
you could use nested dictionary objects:
Sub splitByColB()
Dim r As Range, ar, val1, val2, prefix As String
Dim obj1 As Object, obj2 As Object
Set obj1 = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet1")
For Each r In .Range("B2:B4")
Set obj2 = CreateObject("Scripting.Dictionary")
With obj2
For Each val2 In Split(Replace(r.Value2, " ", vbNullString), ";")
prefix = GetLetters(CStr(val2))
.Item(prefix) = .Item(prefix) & val2 & " "
Next
End With
Set obj1.Item(r.Offset(, -1).Value2) = obj2
Next
.Range("A2:B4").ClearContents
For Each val1 In obj1.keys
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(obj1(val1).Count).Value = val1
For Each val2 In obj1(val1).keys
.Cells(.Rows.Count, 2).End(xlUp).Offset(1).Value = obj1(val1)(val2)
Next
Next
End With
End Sub
Function GetLetters(s As String) As String
Dim i As Long
Do While Not IsNumeric(Mid(s, i + 1, 1))
i = i + 1
Loop
GetLetters = Left(s, i)
End Function

Shuffle values to a new row two cells at a time

To explain it in the easiest way possible:
| 1 | 2 | 3 | 4 |
| 5 | 6 | 7 | 8 |
... needs to look like:
| 1 | 2 |
| 3 | 4 |
| 5 | 6 |
| 7 | 8 |
I've tried using the TRANSPOSE() function, but it doesn't seem to work in this situation.
How can I accomplish this simple task?
In an unused cell to the right use this formula,
=OFFSET($A$1, INT((ROW(1:1)-1)/2), COLUMN(A:A)-1+MOD((ROW(1:1)-1), 2)*2)
Fill right one column and fill down as far as necessary. Your results should resemble the following.
      
You put excel-vba in your tags, so I'll post the vba code for you. I don't know how to do it with simple cell formulas. Hopefully it's configurable enough to get what you want, beyond the simple example you gave:
START_ROW = 1
START_COL = 1
STEP_COL = 2
OUTPUT_ROW = 3
OUTPUT_COL = 10
Row = START_ROW
Col = START_COL
Out_Row = OUTPUT_ROW
While Cells(Row, Col).Value <> ""
While Cells(Row, Col).Value <> ""
For step = 0 To STEP_COL - 1
Cells(Out_Row, OUTPUT_COL + step).Value = Cells(Row, Col + step).Value
Cells(Out_Row, OUTPUT_COL + step).Value = Cells(Row, Col + step).Value
Next step
Out_Row = Out_Row + 1
Col = Col + STEP_COL
Wend
Col = START_COL
Row = Row + 1
Wend

Grouped Stacked Chart in Excel

I have the following data in Excel.
Project | Month | Calls Created | Open Calls | Closed Calls
Requests | Dec 2012 | 15 | 11 | 7
Requests | Jan 2013 | 6 | 8 | 9
Requests | Feb 2013 | 6 | 5 | 2
dotcom | Dec 2012 | 1 | |
dotcom | Jan 2013 | | 1 |
dotcom | Feb 2013 | 1 | 2 | 1
The data is only a small subset. For the full dataset, there will be four projects, and the dates range from 2012 to June 2014
I am trying to create a chart, that for month and each project the data is bar stacked, while the overlying X axis is the Month
I have attached an mockup of the chart that I am looking to produce
I can create stacked bar chart if I only want to use one of Calls Created, Open Calls, Closed Calls. However I need a chart that will combine all three
I show you what I think. If are ok, it's simple to adapt...
Following the scheme:
you have something like you need, but use a simple Chart Bar. The trick is to convert the data in the correct way. To do that I have Used VBA because it's more flexible...
Using this code inside a module connected to a button (Update) ... :
Dim N0(1 To 100) As String
Dim N1(1 To 100) As String
Dim N2(1 To 100) As String
Dim N3(1 To 100) As String
Range("B14:H44").Clear
Range("B1").Select
e = 0
For i = 1 To 9999
If ActiveCell.Offset(i, 0).Value = "" Then Exit For
e = e + 1
N0(e) = ActiveCell.Offset(i, 0).Value
N1(e) = ActiveCell.Offset(i, 1).Value
N2(e) = ActiveCell.Offset(i, 2).Value
N3(e) = ActiveCell.Offset(i, 3).Value
Next
Range("B15").Select
For i = 1 To e
If (i > 1) And (N0(i) = N0(1)) Then Exit For
ActiveCell.Offset((i - 1) * 4, 0).Value = "["
ActiveCell.Offset((i - 1) * 4 + 1, 0).Value = N0(i)
ActiveCell.Offset((i - 1) * 4 + 2, 0).Value = "]"
ActiveCell.Offset((i - 1) * 4 + 3, 0).Value = ""
Next
nRep = i - 1
Debug.Print nRep
nrow = 0
For i = 1 To e
If (i > nRep) And (N0(i) = N0(1)) Then nrow = nrow + 1
For k = 1 To 99
If ActiveCell.Offset((k - 1) * 4 + 1, 0).Value = "" Then Exit For
If ActiveCell.Offset((k - 1) * 4 + 1, 0).Value = N0(i) Then
ActiveCell.Offset((k - 1) * 4, 1 + nrow).Value = N1(i)
ActiveCell.Offset((k - 1) * 4 + 1, 1 + nrow).Value = N2(i)
ActiveCell.Offset((k - 1) * 4 + 2, 1 + nrow).Value = N3(i)
End If
Next
Next
The macro generate the NEW range Data for the Chart... The blank lines are used to visual divide the bars in base of the Mounth...
After, manually or if you prefer via VBA, you can adapt the chart (Decreasing the gap Width, add Labels ...)

Excel to calculate if values in ranges meet certain criteria using VBA

I have two ranges in excel, say:
x | y
------------
5 | -1
46 | -4
2 | 1
67 | -1
22 | 1
6 | 0
34 | 0
7 | -2
I want calculate the sum of the second column for values less than O only if the respective values in the first column is less than 10 (i.e sum(y(i) for i<0 and x(i)<10) . Hence in this case the sum will be -3.
Assuming your headers are in A1:B1 and your data is A2:B9 use this:
=SUMIFS(B2:B9,A2:A9,"<10",B2:B9,"<0")
Try something like
Function calc() AS Integer
Dim sum AS Integer: sum = 0
Dim c AS Range
For Each c In ThisWorkbook.Worksheets(1).Range("A1:A15")
If c.Value < 10 And c.Offset(0, 1).Value < 0 Then
sum = sum + c.Offset(0, 1).Value
End If
Next c
calc = sum
End Function

Resources