Okay so I have a bunch of data in table format like this:
|A | B |
------------------------
1 |102 | a, b, d, f, g |
------------------------
2 |104 | a, c, e |
------------------------
I'm new to using macros or using VBA, so is it possible to create a macro to map, individually, what's in column B to column A like this:
|A | B |
---------------
1 |102 | a |
---------------
2 |102 | b |
---------------
3 |102 | d |
---------------
etc..
I've looked online at a bunch of VBA tutorials and don't see anything like this.
Try below code :
Sub sample()
Dim lastRow As Long, i As Long, j As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastRow
temp = Split(Cells(i, 2), ",")
For j = LBound(temp) To UBound(temp)
Cells(Cells(Rows.Count, 3).End(xlUp).Row + 1, 3).Value = Cells(i, 1)
Cells(Cells(Rows.Count, 4).End(xlUp).Row + 1, 4).Value = temp(j)
Next
Next
End Sub
Related
I'm trying to set up a nested loop that can tie together different columns only when the column in question has data.
What I have is a table like this:
|Aname |aterm |amod |
| | | |
|Smith, Bob | | |
| | | |
| | | |
| | 2/6/2017| |
| | | |
| | |Module 1 |
| | | |
|Smith, John | | |
| | | |
| | | |
| |5/12/2017| |
| | |Module 6 |
| | | |
| | |Module 4 |
| | | |
| |6/12/2017| |
| | | |
| | |Module 10|
| | |Module 5 |
What I am trying to do is tie the columns together like so:
|aname |aterm |amod |
|Smith, Bob | 02/6/2017 | Module 1 |
|Smith, John | 5/12/2014 | Module 6 |
|Smith, John | 5/12/2014 | Module 4 |
|Smith, John | 6/12/2014 | Module 10 |
|Smith, John | 6/12/2014 | Module 5 |
Below is the code I put together to pull this off. Unfortunately, the printing is picking up the aname dozens of time, the aterm intermittently, and the amod not at all.
Sub looper()
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
aname = ""
aterm = ""
amod = ""
Set listenroll = [table1[aname]]
Set atermrange = [table1[aterm]]
Set amodrange = [table1[amod]]
For Each rng In listenroll
If IsEmpty(rng) = False Then
Set aname = rng
For Each rng2 In atermrange
If IsEmpty(rng2) = False Then
Set aterm = rng2
For Each rng3 In amodrange
If IsEmpty(rng3) = False Then
Set amodrange = rng3
Range("I1").End(xlDown).Offset(1, 0) = aname
Range("J1").End(xlDown).Offset(1, 0) = aterm
Range("K1").End(xlDown).Offset(1, 0) = amod
End If
Next rng3
End If
Next rng2
End If
Next rng
Does anyone know what the problem is here?
I have an alternative solution for you. This is basically the same thing with YowE3K's code, however there is one more for loop and one less if statement. This is because, instead of using table names I used column A B C assuming your table is there, and also stored the values in an array.
Try this:
Sub looper()
Dim i As Long, j As Long, LastCell As Long
Dim arr() As String
ReDim arr(2)
With Sheets("Sheet1")
LastCell = .UsedRange.Rows.Count
For i = 2 To LastCell
For j = 1 To 3
If Not IsEmpty(.Cells(i, j)) Then
arr(j - 1) = .Cells(i, j)
If j = 3 Then
.Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0) = arr(0)
.Cells(.Rows.Count, "J").End(xlUp).Offset(1, 0) = arr(1)
.Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0) = arr(2)
End If
End If
Next j
Next i
End With
End Sub
You only need one loop:
Sub looper()
Dim aname As String
'Dim aterm As String
Dim aterm As Date
Dim amod As String
aname = ""
'aterm = ""
aterm = 0
amod = ""
Set listenroll = [table1[aname]]
Set atermrange = [table1[aterm]]
Set amodrange = [table1[amod]]
Dim r As Long
For r = 1 to amodrange.Rows.Count
'Record value of AName whenever it changes
If Trim(listenroll(r, 1).Value) <> vbNullString Then
aname = Trim(listenroll(r, 1).Value)
End If
'Record value of ATerm whenever it changes
If Trim(atermrange(r, 1).Value) <> vbNullString Then
'aterm = Trim(atermrange(r, 1).Value)
aterm = CDate(atermrange(r, 1).Value)
End If
'Write output each time there is something in amod
If Trim(amodrange(r, 1).Value) <> vbNullString Then
amod = Trim(amodrange(r, 1).Value)
Range("I1").End(xlDown).Offset(1, 0) = aname
Range("J1").End(xlDown).Offset(1, 0) = aterm
Range("K1").End(xlDown).Offset(1, 0) = amod
End If
Next
Note: I'm not sure how to modify aterm to match your question's example, but I'm hoping that's just a typo in the example.
And, FWIW, you have one major error in your existing code at the point where you say Set amodrange = rng3. I'm not sure whether that is the only error.
I am trying to write an excel function that will output a range containing a subset of values based on a value range and a filter range and a criteria.
Using the example below, I want to pass Range("A2:A5") and Range("B2:B5") to output Range("C2:C5")
+---+-------+-------+-------+
| | A | B | C |
+---+-------+-------+-------+
| 1 | Name | Group | Output|
| 2 | Nick | A | Nick |
| 3 | Marc | A | Marc |
| 4 | Manny | B | Luck |
| 5 | Luck | A | |
+---+-------+-------+-------+
I have written the code below so far. it works fine in vba but not when I call the function within the sheet
D1.function -> =filterFN(A2:A6,B2:B6,D1,"B")
:
Sub test()
Sheets("Sheet2").Range("D1") = filterFN(Sheets("Sheet2").Range("A1:A6"), Sheets("Sheet2").Range("B1:B6"), Sheets("Sheet2").Range("D1"), "B")
End Sub
Function filterFN(valueRange As Range, filterRange As Range, outputRange As Range, criteriaStr As String)
Dim Arr1() As Variant ' declare an unallocated array.
Dim Arr2() As Variant
Dim Arr3(50) As Variant
Dim i, j As Integer
Arr1 = valueRange
Arr2 = filterRange
For i = 1 To UBound(Arr1, 1)
If Arr2(i, 1) = criteriaStr Then
Arr3(j) = Arr1(i, 1)
j = j + 1
End If
Next i
[outputRange].Resize(UBound(Arr3)) = Application.Transpose(Arr3)
filterFN = Arr3(0)
End Function
Many thanks in advance
You cannot use a function called from a worksheet to update that worksheet (or another sheet): all you can do is return a value to the calling cell(s)
http://support.microsoft.com/kb/170787
I'm doing a script where i can count the data from a column if the data duplicate is >3 i will tag it..
My problem is that i need to put a conditional statement where i can count the data within a date range of 1 Month..
Sample Input File:: (mm/dd/yyyy)
Column A | Column B | Column C| Column D
023 | 1/2/2016 | |
023 | 1/3/2016 | |
023 | 1/4/2016 | |
024 | 2/1/2016 | |
024 | 3/1/2016 | |
024 | 4/1/2016 | |
Sample Output File:
Column A | Column B | Column C| Column D
023 | 1/2/2016 | |
023 | 1/3/2016 | |
023 | 1/4/2016 | 1 | 3
024 | 2/1/2016 | |
024 | 3/1/2016 | |
024 | 4/1/2016 | |
If the duplicate data is not within a month range it will not be tag..
What i expect the code to do is count the data from Column A if the data is >3 and the date of all that data from Column B is within a month tag it from Column D and E not all the row but the recent date from Column B
What my code do is count the data from Column A if the data is >3 it will be tag from Column C and D from most recent date from Column B
My code:
Dim i1 As Long, lastRow As Long, countRow As Long
lastRow = Sheet2.Range("T" & Rows.Count).End(xlUp).Row
'xDate = Sheet2.Range("C" & lastRow)
For i1 = 1 To lastRow
If countRow > 2 Then
countRow = Application.CountIf(Sheet2.Columns(20), Sheet2.Cells(i1, 20))
If countRow > 2 Then
If Not CBool(Application.CountIfs(Sheet2.Columns(20), Sheet2.Cells(i1, 20), _
Sheet2.Columns(85), ">" & Sheet2.Cells(i1, 85))) Then _
Sheet2.Cells(i1, 86).Resize(1, 2) = Array("1", "3")
End If
End If
Next i1
Note:
In my code i didn't use Column A B C D instead it's Column T CG CH CI
I don't know how to range it to a month, i tried collection but still new to VBA and I'm not familiar with it and i don't know if it's the right thing..
edited: left only code as per last OP's specs and with a formula correction
you could try this
Sub sbFindDuplicatesInColumn_C3ter()
With ThisWorkbook.Worksheets("duplicates") '<~~ you should know what workbook and worksheet you are on!!
With .Range("T1").Resize(.Range("T" & .Rows.Count).End(xlUp).Row) ' the "base" column is column "T"
With .Offset(, 67) ' column "CI" is 67 columns away from column "T"
.FormulaR1C1 = "=IF(COUNTIFS(C20, RC20, C72,""<="" & EOMONTH(RC72,0), C72,"">="" & EOMONTH(RC72,-1)+1 )>2, IF(COUNTIFS(C20, RC20,C72,"">"" &RC72,C72,""<="" & EOMONTH(RC72,0))=0, 3 , """") , """")" ' substituted relative references with absolute ones : column "T" has index 20, column "BT" has index 72
.Value = .Value '<== if you want to get rid of formulas
End With
With .Offset(, 66) ' column "CH" is 66 columns away from column "T"
.FormulaR1C1 = "=IF(RC[1]>0, 1, """") " ' I left relative references since columnn "CH" is always one left of column "CG" as was for columns "A" and "B"
.Value = .Value '<== if you want to get rid of formulas
End With
End With
End With
End Sub
This input ...
generated this output ...
from this code ...
Option Explicit
Sub main()
Dim iLoop As Long, jLoop As Long
Dim lastRow As Long, countRow As Long
Dim myDate1 As Variant, myDate2 As Variant
lastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For iLoop = 1 To lastRow
countRow = Application.CountIf(Sheet1.Range(Sheet1.Cells(iLoop, 1), Sheet1.Cells(lastRow, 1)), Sheet1.Cells(iLoop, 1))
If countRow > 2 Then
For jLoop = lastRow To (iLoop + 1) Step -1
If Sheet1.Cells(jLoop, 1).Value = Sheet1.Cells(iLoop, 1).Value Then
myDate1 = Application.EDate(Sheet1.Cells(iLoop, 2), 3)
myDate2 = Sheet1.Cells(jLoop, 2)
If myDate2 > myDate1 Then Sheet1.Cells(jLoop, 3).Resize(1, 2) = Array("1", "3")
Exit For
End If
Next jLoop
End If
Next iLoop
End Sub
Specifically, using the worksheet function EDate to add three months to the first date found for a given item number.
Also, shortening the size of the list the worksheet function CountIf uses as the loop counter iLoop progresses.
As an aside, in your code snippet you used i1 as a loop counter. It is easy to confuse this with il. 8)
I would like to create a VBA macro that will auto number all cells in column 'A' to a single decimal place, if and only if they have a value in column 'B'. Every time there is a row that does not have a value in column 'B', column 'A' should re-start numbering at the next integer.
IE:
|COLUMN A | COLUMN B|
|:-------:|:-------:|
| 1.1 | TEXT |
| 1.2 | TEXT |
| 1.3 | TEXT |
| 1.4 | TEXT |
| 1.5 | TEXT |
| | *NO TEXT* |
| 2.1 | TEXT |
| 2.2 | TEXT |
| 2.3 | TEXT |
| | *NO TEXT* |
| 3.1 | TEXT |
| 3.2 | TEXT |
| 3.3 | TEXT |
| 3.4 | TEXT |
I think this is pretty self-explanatory, but post up if anything confuses you:
Option Explicit
Private Sub numberCells()
Dim totalRows As Long
Dim i As Long
Dim baseNumber As Long
Dim count As Integer
totalRows = ActiveSheet.UsedRange.Rows.count
baseNumber = 1
i = 2
Do While i <= totalRows
If Range("B" & i).Value <> "" Then
count = count + 1
Range("A" & i).Value = baseNumber & "." & count
Else
baseNumber = baseNumber + 1
count = 0
End If
i = i + 1
Loop
End Sub
I like using .Areas,
Here's my version
Sub Do_It_Good()
Dim RangeArea As Range, c As Range, LstRw As Long, sh As Worksheet, Rng As Range
Set sh = Sheets("Sheet1")
With sh
LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
Set Rng = .Range("B2:B" & LstRw)
y = 0
For Each RangeArea In Rng.SpecialCells(xlCellTypeConstants, 23).Areas
y = y + 1
x = 0
For Each c In RangeArea.Cells
c.Offset(, -1) = y & "." & 1 + x
x = x + 1
Next c
Next RangeArea
End With
End Sub
So i have a matrix formatted as so:
| | joe | michelle | tom |
|:-----: |:---: |:--------: |:---: |
| red | 1 | 0 | 1 |
| blue | 0 | 1 | 0 |
| green | 0 | 0 | 0 |
I'm trying to write VBA in excel to create two columns based on this table. If the cell inside the matrix is equal to "1", then I want to write the column name and row name into a list. So for example, because row "red" has a "1" in columns "joe" and "tom", and row "blue" has a "1" under "michelle", my new table would be like this:
| joe | red |
| tom | red |
| michelle | blue |
Here is the VBA i wrote so far, but it doesn't work and i hit a road block.
sub subname()
dim i as integer
for i = 1 to 3
if cells(2,i).value=1 then
cell(5,i).value = cells(1,i).value
end if
next i
end sub
You have only one cycle ...
Dim x As Integer
Range("B19").Select
x = 4
For i = 1 To 3 ' Row
For e = 1 To 3 ' Column
If ActiveCell.Offset(i, e).Value = "1" Then
x = x + 1
ActiveCell.Offset(x, 0).Value = ActiveCell.Offset(0, e).Value
ActiveCell.Offset(x, 1).Value = ActiveCell.Offset(i, 0).Value
End If
Next
Next
I consider B19 the top_left corner of the table ...
Ok the correct code is:
Dim i As Integer
For i = 1 To 3
If Cells(2, i + 1).Value = 1 Then
Cells(5, 1).Value = Cells(1, i + 1).Value
End If
Next i
If the top_left of the table is A1 The error is the reference of i. You need to add 1 or change the cycle from 2 to 4.The second "error" it's to put the value in cell(5,i) instead of cells(5,1). In that case you have to put the name in a fix position. In a cycle you change in Cells(5+e,1)...
You can use this code also.
Sub prabhat()
Dim rng As Range
Dim r As Integer
Dim c As Integer
Dim lastRow As Integer
Dim lastRow2 As Integer
Set rng = Range("a2:d4")
For Each dng In rng
lastRow = Range("E" & Rows.Count).End(xlUp).Row
lastRow2 = Range("F" & Rows.Count).End(xlUp).Row
If dng.Value = 1 Then
r = dng.Row
c = dng.Column
Range("E" & lastRow + 1).Value = Cells(r, 1).Value
Range("F" & lastRow2 + 1).Value = Cells(1, c).Value
End If
Next dng
End Sub