Combine two columns of data into one in excel vba - excel

Looking for a solution to combine to columns of data into one in Excel. The data is not adjacent, so I wish to combine data in Column A with data in Column C, placing the results into Column E.
An example:
Row A B C D E (Desired result)
1 1
2 1 2 2
3 3 4 3
4 5 6 4
5 1 2 5
6 6
7 7 8 7
8 8
It's important that the data is in order of first appearance by row. As an aside it would also be good to avoid duplicates (see the second 1 & 2 not duplicated in example col E), but that is easily dealt with afterwards.
I also need it to ignore blank cells.
Would prefer to achieve this via VBA.

Loop through all the cells in columns A and C, if they don't already exist in Column E, list them sequentially:
Sub Test()
With ActiveSheet
For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Cells(i, 1).Value <> "" Then
If WorksheetFunction.CountIf(.Range("E:E"), Cells(i, 1).Value) = 0 Then
Cells(.Cells(.Rows.Count, 5).End(xlUp).Row + 1, 5).Value = Cells(i, 1).Value
End If
End If
If Cells(i, 3).Value <> "" Then
If WorksheetFunction.CountIf(.Range("E:E"), Cells(i, 3).Value) = 0 Then
Cells(.Cells(.Rows.Count, 5).End(xlUp).Row + 1, 5).Value = Cells(i, 3).Value
End If
End If
Next i
End With
End Sub

Related

Moving a range of cells to another sheet based on value in cell

I don't even know how to word this correctly which is doubtlessly why i am having trouble.
So I have 3 columns, names, time, values in each row.
I want to take all the times next to the same name and put them in another sheet, under a column headed by the persons name.
I would be happy with the first part but in addition, if possible, I would also like to make sure that the when the times get posted they are related to the values they were originally next to.
example:
john 7 10
john 5 20
john 6.5 30
amy 14 10
amy 8 20
amy 2 40
becomes
john amy
10 7 14
20 5 8
30 6.5
40 2
Dim i As Integer, j As Integer
j = 6
Cells(1, 6).Value = Cells(1, 1).Value
For i = 2 To 6
If Cells(i, 1).Value <> Cells(1, j).Value Then
Cells(1, j + 1).Value = Cells(i, 1).Value
j = j + 1
End If
Next i
Range("C1:C6").Copy
Range("E2:E7").PasteSpecial
Range("E2:E7").Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlNo
Range("E2:E7").RemoveDuplicates Columns:=1, Header:=xlNo
For k = 1 To 6
For m = 6 To 9
For n = 2 To 6
If Cells(k, 1).Value = Cells(1, m).Value And Cells(k, 3).Value = Cells(n, 5).Value Then
Cells(n, m).Value = Cells(k, 2).Value
End If
Next n
Next m
Next k
This code solves your particular example. Keep in mind that this is not a versatile code so you gonna have to change the limits of the loops and ranges in your actual thing.
No need for VBA here, just use the powerful tools Excel has already built in to analyze your data:
Create a PivotTable to analyze worksheet data and the result will be like below. If you change values in the orginal data you will just need to update the PivotTable.
Image 1: Original data and PivotTable side by side (sorry for the German screenshot).

Remove any rows containing values from previous row's cell's values

I have an excel table that should contains only unique values in each row. If any of the previous cell values repeating anywhere in the other rows, the complate row should be deleted. The example table is like so
Example
Table The result
______ _____
0 1 3 0 1 3
6 4 1 5 -> 8 9 2
8 9 2
The second row should be cleared because the first row already contains 1 . But the third row should be there because it doesn't contains any duplicates from the previous rows.
I need excel formula to filter like so or vba code with multi dimensional array clearing the unwanted rows.
Try this one...
It works with all the samples I took.
Dim i, j, k, l As Long
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
For k = 1 To LastRow
For i = k + 1 To LastRow
For j = 1 To LastCol
For l = 1 To LastCol
If (Sheets(1).Cells(i, j).Value2 <> "") And _
(Sheets(1).Cells(k, j).Value2 <> "") And _
(Sheets(1).Cells(i, j).Value2 = Sheets(1).Cells(k, l).Value2) Then
Sheets(1).Cells(i, j).EntireRow.ClearContents
End If
Next
Next
Next
Next
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Insert Rows based on a Cell value and fill down

I currently have a sheet with values that look like this, as an example:
1 A B C D..............
2 1 Title of item 1
3 Formulas and formatting 1
4 2 Title of item 2
5 Formulas and formatting 2
6 3 Title of item 3
7 Formulas and formatting 3
What i want to happen is that the code looks up column A. If column A contains a number > 1 then it inserts that number (-1) rows, but 2 rows down. I then need it fill the formulas (the formulas need to be dragged down) and formats down from the row above to the last row inserted for that section. So it would look something like this:
1 A B C D...............
2 1 Title of item 1
3 Formulas and formatting 1
4 2 Title of item 2
5 Formulas and formatting 2
6 Formulas and formatting 2
7 3 Title of item 3
8 Formulas and formatting 3
9 Formulas and formatting 3
10 Formulas and formatting 3
And so on and so.... Note, it needs to drag the entire row formulas and foramts, not just A-D...
I think I am almost there with the following code, but I can't get it to fill down from the first row with formulas, under the value in A, until the last row inserted for that section....
Here's my code:
Sub Add_Rows()
Dim r As Long
Application.ScreenUpdating = False
For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(r, "A").Value > 1 Then Rows(r + 2).Resize(Cells(r, "A").Value - 1).Insert
Next r
Application.ScreenUpdating = True
End Sub
If any one could help me with the above that would be amazing!! Equally, I think my method might be a bit clumsy, so I am open to more eloquent solutions too!! Thanks Guys, this forum has saved my skin so many times!!! One day I hope I will get to a point where I can maybe answer some questions instead of always asking them!
Try this. You're not actually copying and pasting anything.
Sub Add_Rows()
Dim r As Long
Application.ScreenUpdating = False
For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If IsNumeric(Cells(r, "A")) Then
If Cells(r, "A").Value > 1 Then
Rows(r + 2).Resize(Cells(r, "A").Value - 1).Insert shift:=xlDown
Rows(r + 1).Copy
Rows(r + 2).Resize(Cells(r, "A").Value - 1).PasteSpecial xlPasteAll
End If
End If
Next r
Application.ScreenUpdating = True
Application.CutCopyMode = False
Application.Goto Range("A1")
End Sub

Compare two columns in excel and seeing if values are the same

This image shows the before. https://drive.google.com/open?id=0B8BmxxuBoGYnVkhDaEF2b1J6ejA
The objective of the code is to look at the value of the first cell of column 1 then look for that same value in Column 4 by going down the Column. In the case of the first cell in Column 1 it would be honey and the corresponding row in Column 4 is 6. Then it will duplicate the values from Column 5 and Column 6 that corresponds with honey in Column 4 and put it in Column 2 and Column 3 in the row that corresponds with honey for Column 1. Every time a cell in Column 2 or Column 3 is filled it will be colored blue. I don't know how to get the syntax right to set a string in one cell equal to a string in another cell and determining if the cell is blank in the first place.
This image shows the after.
https://drive.google.com/open?id=0B8BmxxuBoGYnX1VXWllaQTAxWFE
Sub checkcolumns()
'j determines the row for Column 1. n determines the row for Column 4'
Dim j As Integer
Dim n As Integer
j = 1
n = 1
'The first part is a Do While loop and is intended to check if the first
'cell is filled with something. If it's not then the code won't run.'
Do While Cells(j,1).Value <> Not vbNullString
'The next part determines whether the first cell from Column 1 and
'first cell from Column 4 are the same. If they aren't then it will
'search for the cell in Column 4 that has the same value. n denotes the row
'for column 4 and the Do Until loop will determine which row in column 4
'has the exact value as the cell we're looking at from Column 1
if Cell(j,1) NotEqual Cell(n, 4)
Do Until cell(j, 1) Equalto Cell(n, 4)
n = n + 1
End
'The next if statements first determine whether Column 2 of the row we're
'looking at has a value already. If it does not then that cell is
'populated with whatever value is in Column 5 of the corresponding row for
'Column 4 which is found with n. This is repeated for Column 3 using
'Column 6.
if Cells(j, 2).Value <> vbNullString Then
Cells(j, 2) = Cells(n, 5)
Cells(j, 2).Interior.ColorIndex = 5
End if
if Cells(j, 3).Value <> vbNullString Then
Cells(j, 3) = Cells(n, 6)
Cells(j, 3).Interior.ColorIndex = 5
End if
'This else statement below is for the case where the cell value from
'Column 1 on that row is equal to the cell value of Column 4 on that
'same row, so j and n would be equal.
Else
if Cells(j, 2).Value <> vbNullString Else
Cells(j, 2) = Cells(n, 5)
Cells(j, 2).Interior.ColorIndex = 5
End If
if Cells(j, 3).Value <> vbNullString Else
Cells(j, 3) = Cells(n, 6)
Cells(j, 3).Interior.ColorIndex = 5
End If
End If
'Once it has checked the first row in Column 1. It will then look at the
'second row.
j = j + 1
End
End Sub
Put this formula in B2:
=VLOOKUP(A2,$D$2:$F$7,2,FALSE)
And then put this formula in C2:
=VLOOKUP(A2,$D$2:$F$7,3,FALSE)
A2 is the value you want to search in column D
$D$2:$F$7 creates a static table to search
2 or 3 is the column in that table (from first col of table) you want returned
False requires an exact match on the search
Once you put them in the cells, drag them down.

how to transform three columns to a matrix using macro

I need some help converting three colums into a matrix using excel macro.
Here is an example:
From this:
A A 0
A B 23
A C 3
B A 7
B B 56
B C 33
C A 31
C B 6
C C 5
to this:
A B C
A 0 23 3
B 7 56 33
C 31 6 5
Hope you can help me.
Thanks
Not quite sure what exactly you are meaning by matrix. For the code below I assumed you were looking for a way to read the data in the first two columns as Row and Column data of the output table. Assume the input data is in the Columns 1 - 3 of "Sheet1"
Sub ConvertTableOfData()
Dim testArray(1 to 3)
Dim chkROW as Integer
Dim chkCOL as Integer
Dim chkVAL as Integer
'// index the Row and Column headers
testArray(1) = "A"
testArray(2) = "B"
testArray(3) = "C"
'// Iterate through every row in the initial dataset
For i = 1 to Worksheets("Sheet1").Cells(1, 1).End(xlDown).Row
With Worksheets("Sheet1")
'// Assign the Output Row and Column values
'// based on the array indices
For j = 1 to UBound(testArray, 1)
If .Cells(i, 1) = testArray(j) Then
chkROW = j
End If
If .Cells(i, 2) = testArray(j) Then
chkCOL = j
End If
Next j
'// store the actual value
chkVAL = .Cells(i, 3)
End With
'// output table (in Sheet2)
With Worksheets("Sheet2")
.Cells(chkROW, chkCOL) = chkVAL
End With
Next i
'// Add headers to Output table
For i = 1 to 3
With Worksheets("Sheet2")
.Cells(i + 1, 1) = testArray(i)
.Cells(i, i + 1) = testArray(i)
End With
Next i
End Sub
You can also perform this without VBA.
Assume your table of data is in the range A1:C9.
Assume the first number (0) in the 3 by 3 grid of data is cell F3, with A, B, C in the row above, and A, B, C in the column to the left.
Enter the formula in cell F3 as
=INDEX($C$1:$C$9,SUMPRODUCT(--($A$1:$A$9=$E3),--($B$1:$B$9=F$2),ROW($A$1:$A$9)))
Copy this formula to all 9 cells in the 3 by 3 grid.
This generalized to any size of data.

Resources