I don't know how to create a macro to find duplicates of characters.
This picture shows the expected result.
This picture is my actual result.
This is my attempted code:
Sub atrod_dublikatus()
' atrod_dublikatus Macro
Dim a, b, skaits As Integer
skaits = 0
For a = 1 To 11
For b = a + 1 To 11
If Cells(a, 1).Value = Cells(b, 1) Then
skait = skait + 1
Cells(a, 2).Value = skait
Cells(b, 2).Value = skait
End If
Next b
Next a
End Sub
You don't need VBA for this, you can do it with a formula and an expanding range (Note the position of the $ sign in only one part of the range)
=IF(COUNTIF(A$1:A1,A2)>0,VLOOKUP(A2,A:B,2,0),IF(COUNTIF(A:A,A2)>1,MAX(B$1:B1)+1,""))
Put a heading in A1 (You need this for the formula to work)
Put the formula in B2 then drag down, see below for my test data
Heading
Hello 1
World 2
Blah 3
Off
On
Blah 3
Blah 3
World 2
Blah 3
Hello 1
Related
Looking to fill blank values in a row with the 'top' value, similar to the functionality provided by Editing>Fill>Top. The difference being that the Fill function requires you to go row-by-row rather than applying itself to a larger dataset. Example below:
Apple 1 foo
Banana 1 foo
2 foo
bar
Cherry 2 bar
3 foo
6 bar
Grape 1 foo
Would end up as the following:
Apple 1 foo
Banana 1 foo
Banana* 2 foo
Banana* 2* bar
Cherry 2 bar
Cherry* 3 foo
Cherry* 6 bar
Grape 1 foo //new values represented with *
Note that the third entry in the second column (2) was also brought down implying this could be applied to multiple columns.
The value in this would be converting a table that has the relationships Cherry>2, Cherry>3, Cherry>6 represented in the first table into a format that could be used as an associative table.
Try this short macro:
Sub FillInTheBlanks()
Dim i As Long, N As Long, j As Long
N = Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To N
For j = 1 To 2
If Cells(i, j).Value = "" Then Cells(i, j).Value = Cells(i, j).Offset(-1, 0).Value
Next j
Next i
End Sub
I thought id add my variation on this one. Works when you just want to select a range
Sub BlankCellAll()
For Each c In Worksheets("Sheet1").Range("A3:R14").Cells
If c.Value = "" Then c.FormulaR1C1 = "=R[-1]C"
c.Value = c.Value
Next
End Sub
I'm attempting to transpose - if that's the right application of the term - pairs of columns into repeating rows. In concrete terms, I need to go from this:
Thing1 6 0.29 5 0.23 7 0.19 8 0.11
to this:
Thing1 6 0.29
Thing1 5 0.23
Thing1 7 0.19
Thing1 8 0.11
This operation will occur with at least 7 pairs of columns for several hundred "things." The part I can't figure out is how to group/lock the pairs to be treated as one unit.
In some ways, I'm trying to do the opposite of what is normally done. One example is here: Transpose and group data but it doesn't quite fit, even if I attempt to look at it backwards.
EDIT: Another example that is similar, but I need to do almost the reverse: How to transpose one or more column pairs to the matching record in Excel?
My VBA kung fu is weak, but I'm willing to try whatever your collective wisdom suggests.
Ideas are welcome, and in any case, thank you for reading.
Here is the Excel formula solution just in case. If the source data starts at A1, then formula in the first destination cell will be =$A$1 and the 2 formulas to the right will be
= OFFSET( A$1, 0, ROW( A1 ) * 2 - 1 )
and
= OFFSET( A$1, 0, ROW( A1 ) * 2 )
copy the 3 formula cells and paste in the range below them
Update
VBA version (set r to the source range and replace c3 with the first cell in the destination range)
Set r = [a1:i1]
set d = [c3].Resize(r.Count \ 2, 3)
d.Formula = "=index(" & r.Address & ",if(column(a1)=1,1,row(a1)*2-2+column(a1)))"
Here is a VBA solution.
To implement this, press Alt+F11 to open the VBA editor.
Right click to the left side and select "Insert Module"
Paste the code into the right side of this.
You may want to change the output sheet name as I have shown in the code.
I use Sheet2 to place the transposed data, but you can use whatever you want.
After you have done this, you may close the editor and select the sheet with your non-transposed data.
Run the macro by pressing Alt+F8, clicking on the macro, and pressing Run
Sheet2 should contain the results you are looking for.
Sub ForJeremy() 'You can call this whatever you want
Dim EndCol, OutSheet, OutRow, c, x
Application.ScreenUpdating = False
EndCol = ActiveSheet.UsedRange.columns.Count
'What sheet do I put these values on?
Set OutSheet = Sheets("Sheet2") 'Put the name in the quotes
OutSheet.Cells.Delete xlShiftUp 'This clears the output sheet.
OutRow = 1
For Each c In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:A"))
For x = 2 To EndCol Step 2
OutSheet.Cells(OutRow, 1) = c.Value
OutSheet.Cells(OutRow, 2) = Cells(c.Row, x)
OutSheet.Cells(OutRow, 3) = Cells(c.Row, x + 1)
OutRow = OutRow + 1
Next x
Next c
OutSheet.Select
Application.ScreenUpdating = True
End Sub
Input:
Output:
Edit: If you wanted to add an additional column to the beginning that would also just display to the side, you would change the code like this:
For Each c In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:A"))
For x = 3 To EndCol Step 2 'Changed 2 to 3
OutSheet.Cells(OutRow, 1) = c.Value
OutSheet.Cells(OutRow, 2) = Cells(c.Row, 2) 'Added this line
OutSheet.Cells(OutRow, 3) = Cells(c.Row, x) 'Changed to Col 3
OutSheet.Cells(OutRow, 4) = Cells(c.Row, x + 1) 'Changed to Col 4
OutRow = OutRow + 1
Next x
Next c
To better explain this loop,
It goes through each cell in column A from the top to the bottom.
The inner loop scoots over 2 columns at a time.
So we start at column B, and next is D, and next is F .. and so on.
So once we have that value, we grab the value to the right of it as well.
That's what the Cells(c.Row, x) and Cells(c.Row, x + 1) does.
The OutSheet.Cells(OutRow, 1) = c.Value says - just make the first column match the first column.
When we add the second one, OutSheet.Cells(OutRow, 2) = Cells(c.Row, 2) 'Added this line we are saying, match the second column too.
Hope I did a decent job explaining.
It's been 6 years since I've worked with Excel and i'm a little bit rusty. Here's my scenario:
I am exporting a list of issues to Excel. I need to be able differentiate the associated Link numbers in a cell (mulitple values) from each other. Example, i have two columns,
Key = the number for a ticket
Linked Issues = The Keys associated
I need a statement that would scan the Key column and find a match in the Linked Issues column. Then once the match is found the matching text will assume the font color of the Key.
Where this get complicated is each cell of the Linked Issues column could look something like this iss-3913, iss-3923, iss-1649. So essentially the scan would be for a match within the string. Any help is appreciated.
I am sorry, I don't have time to finish this right now, but wWould something like this help with maybe a loop for each cell in the first column?
Edit: Finished now, second edit to update to B5 and Z5, edit 3 fixed goof with column reference and updated to use variables to assign what column to look in.
Sub colortext()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
o = start_row 'start with row one for second column
Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then 'if cell contents found in cell
With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
.Color = Cells(i, key_col).Font.Color 'change color of this part of the cell
End With
End If
o = o + 1 'increment the cell in second column
Loop
i = i + 1 'increment the cell in the first column
Loop
End Sub
or maybe
Something like this?
Excel VBA: change font color for specific char in a cell range
This is an old post but I thought I would provide my work around to the conditional formating issue I was having.
Sub colorkey()
start_row = 5
key_col = 2
flag_col = 4
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
Tval = Cells(i, flag_col).Value
Select Case Tval
Case "Requirement"
'cval = green
cVal = 10
Case "New Feature"
'cval = orange
cVal = 46
Case "Test"
'cval = lt blue
cVal = 28
Case "Epic"
'cval = maroon
cVal = 30
Case "Story"
'cval = dk blue
cVal = 49
Case "Theme"
'cval = grey
cVal = 48
Case "Bug"
'cval = red
cVal = 3
Case "NOT MAPPED"
'cval = Maroon
cVal = 1
End Select
Cells(i, key_col).Font.ColorIndex = cVal
i = i + 1 'increment the cell in the first column
Loop
End Sub
Sub colorlinked()
start_row = 5
key_col = 2
linked_col = 26
i = start_row 'start on row one
Do While Not IsEmpty(Cells(i, key_col)) 'Do until empty cell
o = start_row 'start with row one for second column
Do While Not IsEmpty(Cells(o, linked_col)) 'Do until empty cell
If Not InStr(1, Cells(o, linked_col), Cells(i, key_col)) = 0 Then 'if cell contents found in cell
With Cells(o, linked_col).Characters(Start:=InStr(1, Cells(o, linked_col), Cells(i, key_col)), Length:=Len(Cells(i, key_col))).Font
.Color = Cells(i, key_col).Font.Color 'change color of this part of the cell
End With
End If
o = o + 1 'increment the cell in second column
Loop
i = i + 1 'increment the cell in the first column
Loop
MsgBox "Finished Scanning"
End Sub
I need a VBA code to loop through only those rows in range1(AA:AB) whose value in cell AA is not found in Col A.
eg
A
1
2
4
AA AB
1 Jon
3 Bob
4 Frank
5 Hank
In this example I need to loop through rows containing Bob and Hank only (2 iterations)
Sub cycle()
On Error GoTo Unmatched
Set used_range = ActiveSheet.UsedRange
For Each Line In used_range.Rows
Key = Cells(Line.Row, 2).Value
If (Key <> "") Then
x = Application.WorksheetFunction.VLookup(Key, used_range, 1, False)
End If
Next Line
Exit Sub
Unmatched:
MsgBox (Cells(Line.Row, 2).Value & " " & Cells(Line.Row, 3).Value)
Resume Next
End Sub
Some notes - I used columns B and C (index 2 and 3) for my test - substitute the appropriate column index numbers for your spreadsheet
Put the thin gs you need to do in the code after Unmatched:
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.