I have two columns, Column A has a set of a few standard values and column B has all unique values. I'm only just experimenting with more complex ways of compiling data than the beginner level so I'm a bit at a loss.
I need to either have a lookup or create a macro that will list only the values in A (once each) but also display which values in B correspond to those in A
for example
A | B
va1|abc
va1|bcd
Va2|xyz
va3|zab
will show (in a single cell) the following
va1: abc, bcd
va2: xyz
va3: zab
Please help!
Option Explicit
Sub Test()
Dim i As Long, j As Long, k As Long
k = 1
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountIf(Range("C:C"), Cells(i, 1).Value) = 0 Then
Cells(k, 3).Value = Cells(i, 1).Value
For j = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(j, 1).Value = Cells(k, 3).Value And _
InStr(Cells(k, 4).Value, Cells(j, 2).Value) = 0 Then
If Cells(k, 4).Value = "" Then
Cells(k, 4).Value = Cells(j, 2).Value
Else
Cells(k, 4).Value = Cells(k, 4).Value & ", " & Cells(j, 2).Value
End If
End If
Next j
k = k + 1
End If
Next i
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
Cells(i, 3).Value = Cells(i, 3).Value & ": " & Cells(i, 4).Value
Cells(i, 4).ClearContents
Next i
End Sub
Edited for single cell
In case your requirement is to "have the grouped data", and not exactly "have one single string per A", you can do this with a "pivot table" putting A and B in the row labels, like in the following picture:
Related
I just can't seem to get this for loop running correctly. I know that I missing something basic, but I just can't figure it.
I have 2 tables.
Table 1 : (Table starts at row 7, and columns i to q are hidden)
Table 2 :
My goal is to pull new rows from Table1 to Table2.
My code rolls through Table 1, identifies the rows with an 'R' value, and fills them.
Then I want to pull data from those same rows to Table2
The code that identifies and fills the 'R' value:
Dim iRow As Long
With Sheet12
iRow = Application.Count(.ListObjects("Table1").ListColumns("KEY").DataBodyRange)
End With
'find last row with a date
Dim jRow As Long
With Sheet12
jRow = Application.Count(.ListObjects("Table1").ListColumns("Date").DataBodyRange)
End With
'take the value from iRow and col 1, add 1, place in iRow+1,1
Dim q As Long
For q = iRow + 7 To jRow + 6
Sheet12.Cells(q, 18) = 1 + Sheet12.Cells(q - 1, 18)
Next q
Then this bit I'm having trouble with. My thought was try to run a double loop, where I loop through to fill each column and then each row.
Dim a As Long
Dim b As Long
Dim c As Long
c = jRow - iRow
For b = 11 To c + 11
For a = iRow + 7 To jRow + 6
ws15.Cells(b, 1).Value = "Plaid-" & Sheet12.Cells(a, 8).Value & "-" & Sheet12.Cells(a, 7).Value
ws15.Cells(b, 2).Value = Sheet12.Cells(a, 18).Value
ws15.Cells(b, 3).Value = Sheet12.Cells(a, 3).Value
ws15.Cells(b, 4).Value = Sheet12.Cells(a, 4).Value
ws15.Cells(b, 5).Value = Sheet12.Cells(a, 5).Value
ws15.Cells(b, 6).Value = 1001
ws15.Cells(b, 7).Value = "FILL IN"
Next a
Next b
Now the above code only copies the last row from Table1 into Table2 four times.
I know I'm close, and I'm sure I'm just tired, but I can't get it right. I appreciate everyone's time.
The double loop is causing the problem. The inside loop fills in the same row 4 times. This explains why every row has the same data.
You want to iterate the rows together so you just need 1 loop. The b variable is not needed.
Try this code:
Dim a As Long
Dim c As Long
c = jRow - iRow + 7 'start row on new sheet
For a = iRow + 7 To jRow + 6 'source data rows
ws15.Cells(c, 1).Value = "Plaid-" & Sheet12.Cells(a, 8).Value & "-" & Sheet12.Cells(a, 7).Value
ws15.Cells(c, 2).Value = Sheet12.Cells(a, 18).Value
ws15.Cells(c, 3).Value = Sheet12.Cells(a, 3).Value
ws15.Cells(c, 4).Value = Sheet12.Cells(a, 4).Value
ws15.Cells(c, 5).Value = Sheet12.Cells(a, 5).Value
ws15.Cells(c, 6).Value = 1001
ws15.Cells(c, 7).Value = "FILL IN"
c = c + 1 'next row on new sheet
Next a
I need to make Excel VBA script which inserts formula depending on cells values.
My current version returns only FALSE value
For i = 1 To 10 Step 1
If Cells(i, 2).Value > Cells(i, 1).Value Then Cells(i, 3).Value = Cells(i, 3).Formula = "=cells(i,1).value+cells(i,2).value"
If Cells(i, 2).Value < Cells(i, 1).Value Then Cells(i, 3).Value = Cells(i, 3).Formula = "=cells(i,2).value-cells(i,1).value"
Next i
I geuss you would like to do something like that
For i = 1 To 10 Step 1
If Cells(i, 2).Value > Cells(i, 1).Value Then Cells(i, 3).FormulaR1C1 = "=RC[-2]+RC[-1]"
If Cells(i, 2).Value < Cells(i, 1).Value Then Cells(i, 3).FormulaR1C1 = "=RC[-2]-RC[-1]"
Next i
First, it returns FALSE because you compare the formula of the cell with your string. Those are not equal, hence it returns FALSE. This would be solved by leaving out the =Cells(i,3).Formula part.
Second, it is important to be aware that certain VBA functionality cannot be used in your worksheet and vice versa. When you type '=Cells' in a cell you will note there is no Worksheet function called Cells. That's why the following will return '#Field!'
For i = 1 To 10 Step 1
If Cells(i, 2).Value > Cells(i, 1).Value Then
Cells(i, 3).Formula = "=cells(i,1).value+cells(i,2).value"
End if
If Cells(i, 2).Value < Cells(i, 1).Value Then
Cells(i, 3).Formula = "=cells(i,2).value-cells(i,1).value"
End if
Next i
The easiest thing to do is performing the calculation within VBA:
For i = 1 To 10 Step 1
If Cells(i, 2).Value > Cells(i, 1).Value Then
Cells(i, 3).Value = Cells(i, 1).Value + Cells(i, 2).Value
End if
If Cells(i, 2).Value < Cells(i, 1).Value Then
Cells(i, 3).Formula = Cells(i, 2).Value - Cells(i, 1).Value
End if
Next i
Some recommendations:
Instead of addressing a cell value multiple times, assign the value to a variable.
Try avoiding writing formulas to worksheets. This will slow down your code big time. If you must, then consider storing all the formulas in an array first and only write them to the worksheet when the entire array has been filled.
In this case you can avoid using VBA altogether.
Consider checking if the value of the cell is numeric before performing calculations.
If you insist on using a worksheet function, you could use Storax's suggestion.
I have a piece of code that searches through Sheet("Sub Tasks") and if the number in column A is a decimal, it then makes cells in Sheet("PBS") Column D = to the offset of the decimal cell found in column A. However, I would like the code to work by making row 2,3,4,5,6, and so on (+1) in sheet PBS display the info from Sub tasks.
But at the moment, the info is displayed in the same layout as it is in Sheet("Sub Tasks"). What am i missing from the code.
Dim Lastrow3 As Long, r As Long, n As Long, cell As Range, ws As Worksheet, Lastrow1 As Long
Lastrow3 = Sheets("Sub Tasks").Range("B" & Rows.Count).End(xlUp).Row
Lastrow1 = Sheets("PBS ").Range("D" & Rows.Count).End(xlUp).Row
n = 2
With Worksheets("Sub Tasks")
For Each cell In Sheets("Sub Tasks").Range("A2:A" & Lastrow3)
If IsNumeric(cell.value) Then
If cell.value = Int(cell.value) Then
Worksheets("PBS ").Cells(n, "C").value = cell.value
Worksheets("PBS ").Cells(n, "D").value = cell.Offset(0, 1).value
Worksheets("PBS ").Cells(n, "B").value = cell.Offset(0, 8).value
Worksheets("PBS ").Cells(n, "A").value = cell.Offset(0, 7).value
Worksheets("PBS ").Cells(n, "H").value = cell.Offset(0, 23).value
Worksheets("PBS ").Cells(n, "E").value = cell.Offset(0, 3).value
Else
End If
Else
End If
n = n + 1
Next cell
End With
``````````````````````````
move n = n + 1 to another place.
n = 2
With Worksheets("Sheet1")
For Each cell In Sheets("Sheet1").Range("A2:A" & Lastrow3)
If IsNumeric(cell.Value) Then
If cell.Value = Int(cell.Value) Then
Worksheets("Sheet3").Cells(n, "C").Value = cell.Value
Worksheets("Sheet3").Cells(n, "D").Value = cell.Offset(0, 1).Value
Worksheets("Sheet3").Cells(n, "B").Value = cell.Offset(0, 8).Value
Worksheets("Sheet3").Cells(n, "A").Value = cell.Offset(0, 7).Value
Worksheets("Sheet3").Cells(n, "H").Value = cell.Offset(0, 23).Value
Worksheets("Sheet3").Cells(n, "E").Value = cell.Offset(0, 3).Value
n = n + 1
Else
End If
Else
End If
Next cell
End With
The Sender (Consignor) and Receiver (Consignee) addresses are spread out in 3 different columns each. Hence I create 1 Consignor Address Column and 1 Consignee Address Column into which I want to concatenate the data.
Then I write 2 loops to go through and concatenate the values from the 3 cells.
The first loop works perfectly, while the second one does not really add the values, though when tested with F8 it does run the code so to say.
Can someone explain to me why that is?
Sub CnorCneeAddress()
Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("Q1").Select
ActiveCell.FormulaR1C1 = "Consignee Address"
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I1").Select
ActiveCell.FormulaR1C1 = "Consignor Address"
Dim Worksheet As Worksheet
Set Worksheet = ActiveSheet
LastRow = Worksheet.Cells(Worksheet.Rows.Count, "A").End(xlUp).Row
With Worksheet
For i = 2 To LastRow 'Starting from Row 2 until the LastRow (i , will change depending on the data in column j)
For j = 10 To 12
If IsEmpty(Cells(i, j).Value) Then
Cells(i, 9).Value = Cells(i, 9).Value
ElseIf j = 12 Then
Cells(i, 9).Value = Cells(i, 9).Value & Cells(i, j).Value
Else
Cells(i, 9).Value = Cells(i, 9).Value & Cells(i, j).Value & ", "
End If
Next j
Next i
End With
With Worksheet
For i = 2 To LastRow 'Starting from Row 2 until the LastRow (i , will change depending on the data in column j)
For j = 14 To 16
If IsEmpty(Cells(i, j).Value) Then
Cells(i, 17).Value = Cells(i, 17).Value
ElseIf j = 16 Then
Cells(i, 17).Value = Cells(i, 17).Value & Cells(i, j).Value
Else
Cells(i, 17).Value = Cells(i, 17).Value & Cells(i, j).Value & ", "
End If
Next j
Next i
Columns("M:O").Delete
Columns("J:L").Delete
End With
End Sub
While the data for the Consignor is concatenated correctly, the cells under Consignor Address remain empty.
I do not understand why my code does not concatenate the cells for the Consignee Address.
thank you for your comments. Let me try to make things clearer.
I have data looking roughly so, after the column insertion, that is considered:
Columns 10, 11, 12 are "Consignor City", "Consignor State", "Consignor Post Code"
Column 14, 15, 16 are "Consignee City", Consignee State", "Consignee Post Code"
All variables are strings or integers e.g. if postcode in US..
Please see below picture.
Currently I have the code below running somewhat. I am working with VBA since 4 days, I have taken advanced Python before, so forgive me for still not understanding exactly how VBA works.
How the columns look
Sub CnorCneeAddress()
Columns("N:N").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").Select
ActiveCell.FormulaR1C1 = "Consignee Address"
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I1").Select
ActiveCell.FormulaR1C1 = "Consignor Address"
Dim Worksheet As Worksheet
Set Worksheet = ActiveSheet
lastRow = Worksheet.Cells(Worksheet.Rows.Count, "C").End(xlUp).Row
With Worksheet
For i = 2 To lastRow 'Starting from Row 2 until the LastRow (i , will change depending on the data in column j)
For j = 10 To 12
If IsEmpty(Cells(i, j).Value) Then
Cells(i, 9).Value = Cells(i, 9).Value
ElseIf j = 12 Then
Cells(i, 9).Value = Cells(i, 9).Value & Cells(i, j).Value
Else
Cells(i, 9).Value = Cells(i, 9).Value & Cells(i, j).Value & ", "
End If
Next j
Next i
End With
With Worksheet
For i = 2 To lastRow 'Starting from Row 2 until the LastRow (i , will change depending on the data in column j)
For j = 15 To 17
If IsEmpty(Cells(i, j).Value) Then
Cells(i, 14).Value = Cells(i, 14).Value
ElseIf j = 17 Then
Cells(i, 14).Value = Cells(i, 14).Value & Cells(i, j).Value
Else
Cells(i, 14).Value = Cells(i, 14).Value & Cells(i, j).Value & ", "
End If
Next j
Next i
Columns("O:Q").Delete
Columns("J:L").Delete
End With
End Sub
I have the following code
Dim i As Integer
For i = 3 To 10
If Range("H3").Value = Cells(i, 2).Value And Range("I3").Value < Cells(i, 4).Value And _
Range("I3").Value >= Cells(i, 3).Value Then
Range("J3").Value = Cells(i, 5).Value
End If
Next i
I want the value of J3 to represent the sum of all the iterations and not just the last iteration if i. Can it be done?
While there are certainly better methods of adding up cells, for your particular method this should work.
Dim i As long, lTotal as long
For i = 3 To 10
If Range("H3").Value = Cells(i, 2).Value And Range("I3").Value < Cells(i, 4).Value And _
Range("I3").Value >= Cells(i, 3).Value Then
lTotal = Cells(i, 5).Value + lTotal
End If
Next i
Range("J3").Value = lTotal
Keep a running total of of your loop, then use the running total as your cell's value after you've finished the loop
Change this line
Range("J3").Value = Cells(i, 5).Value
To:
Range("J3").Value = Range("J3").Value + Cells(i, 5).Value