Excel-VBA Insert five empty rows below each group of name - excel

I'm in the middle of trying to do the above but fail. referring to the image below, i need to insert five empty rows below the 4th row (john lee) and another five empty rows below 7th row (bryan key) and another five below 9th row (casey carton) and so on, i got 30+ groups of different name to do. wondering how to write vba for this? thanks.

So 5 blanks after a change in sorted column A?
Const blanks = 5
Dim lastValue As String, i As Long, r As Long
Do
r = r + 1
If r > 1 And lastValue <> Cells(r, 1).Value Then
If Cells(r, 1).Value = "" Then Exit Do
For i = 1 To blanks
Rows(r).Insert Shift:=xlDown
Next
r = r + blanks
End If
lastValue = Cells(r, 1).Value
Loop
the 1 in Cells() is the column index, i.e. 1 == A

Related

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

Excel: How to find the last consecutive column values?

I have a shared excel sheet with records being entered all the time. I want to find the last consecutive entry of a specific Name(its 'A' in this example) and record the value at the begining and ending of last occurance.
The output of the attached excel should be
A,2,34 ---when i open when there were 5 entries
A,5,null ---when i opened when there were 9 entries
A,9,6 ---when i opened when there were 11 entries
A,9,3 ---when i opened when there were 12 entries
please help me with the formula that i can use in a different tab of same excel.
Thanks
this should work.
in column C use this formula. Works from row2 and down. row1 should be irrelevant (no consecutive entries at this point).
=IF(B1=B2,B2&","&A1&","&A2,"")
You can also have a formula display whatever is the last entry for that value. This is for value "A".
=LOOKUP(2,1/(B:B=E1),C:C)
A UDF should be able to handle the relative loop.
Option Explicit
Function LastConColVals(rng As Range, crit As String, _
Optional delim As String = ",")
Dim tmp As Variant, r As Long, rr As Long
'allow full column references
Set rng = Intersect(rng, rng.Parent.UsedRange)
With rng
tmp = Array(crit, vbNullString, vbNullString)
For r = .Rows.Count To 1 Step -1
If .Cells(r, 2).Value = crit Then
tmp(2) = .Cells(r, 1).Value
For rr = r To 1 Step -1
If .Cells(rr, 2).Value = crit Then
tmp(1) = .Cells(rr, 1).Value
Else
Exit For
End If
Next rr
'option 1 - null last value for singles
If rr = (r - 1) Then tmp(2) = "null"
'option 2 - truncate off last value for singles
'If rr = (r - 1) Then ReDim Preserve tmp(UBound(tmp) - 1)
Exit For
End If
Next r
End With
LastConColVals = Join(tmp, delim)
End Function

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.

get data from previous sheets

Can you guys help me out? I think i'm kind of stuck with the code below. I almost got the code that I wanted but at the end it does not do the thing I like.
Dim acs, cos, as_col, as_row As Integer
cos = Sheets.Count
acs = ActiveSheet.Index
as_LRow = Sheets(acs).Cells(Sheets(acs).Rows.Count, "A").End(xlUp).Row
For as_row = 3 To as_LRow
std_number = Sheets(acs).Cells(as_row, 1).Value
earliersheets = acs - 1
For s = 1 To earliersheets
ilast_row = Sheets(s).Cells(Sheets(s).Rows.Count, "A").End(xlUp).Row
For r = 3 To ilast_row
std_number_new = Sheets(s).Cells(r, 1).Value
If std_number = std_number_new Then
a = a & Sheets(s).Cells(r, 6).Value
'Sheets(acs).Cells(as_row, 8).Value = Sheets(s).Cells(r, 8).Value
Sheets(acs).Cells(as_row, 8).Value = Sheets(acs).Cells(as_row, 6).Value & " + " & a
End If
a = ""
Next r
Next s
Next as_row
What I want is:
After adding, manually, a new sheet I want to press on a button. This button activates the code above. What I want is to check a value in a particulaire cell in column "A". If the value in this column matches with the value from previous sheet then display the value in the sixth column in the newly added sheet. The code above does that, but it works only for two sheets. If I make more then two sheets it does not display more values then two.
Update
I added my file in the link: Check.xlsm
After opening this file clear the H-column in the third (and maybe the second sheet) then run the macro within. You'll see what I mean
All I want is to get all the previous values in previous sheet displaced in column-H. For example I marked two cells with values, these values get displayed in the H-column after running the macro.
Your problem was that you were always storing in column H a value created by taking the value from column F of the current sheet and appending the value from column F of the sheet being processed within the loop. When you move to the next sheet within the loop, you're replacing the previous value with a new value.
So, when processing sheet w3-6, you first look at sheet w1-4 and generate a value of "13 + 34" and store that in sheet w3-6's cell H3. Then you look at sheet w2-5 and generate a value of "13 + 18" and replace the value of "13 + 34" currently in sheet w3-6's cell H3 with the value of "13 + 18".
Try this code instead:
Dim acs As Long, cos As Long, as_col As Long, as_row As Long
Dim s As Long
Dim as_LRow As Long
Dim ilast_row As Long
Dim r As Long
Dim a As String
cos = Sheets.Count
acs = ActiveSheet.Index
as_LRow = Sheets(acs).Cells(Sheets(acs).Rows.Count, "A").End(xlUp).Row
For as_row = 3 To as_LRow
std_number = Sheets(acs).Cells(as_row, 1).Value
'Initialise variable containing result to go into column H
a = Sheets(acs).Cells(as_row, 6).Value
'Process earlier sheets in reverse order
'(so that values will be shown in reverse order)
For s = acs - 1 To 1 Step -1
ilast_row = Sheets(s).Cells(Sheets(s).Rows.Count, "A").End(xlUp).Row
For r = 3 To ilast_row
std_number_new = Sheets(s).Cells(r, 1).Value
If std_number = std_number_new Then
'Append value to result string
a = a & " + " & Cstr(Sheets(s).Cells(r, 6).Value)
Exit For
End If
Next r
Next s
'Store result
Sheets(acs).Cells(as_row, 8).Value = a
Next as_row

Search text string for a match and change font color

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

Resources