I am attempting to create a new column that consolidates multiple values into a single Column. The code below has no problems creating a new column exactly where I need it.
Within each newly created column however, I would like my code to Sum the previous 5 cells within the same row. It works currently, but is static(The new column is G in the below example, and it sums B:F). I think I need some sort of Offset function built into it to allow the Range it sums to be dynamic (Previous 5 columns), as it loops through the entire sheet.
Additionally, I would love it to copy the Header information from rows 1-9 from the column to the left of the new column, into the new column, and place the word "Combo" into Row 10 of the new column.
Office 2013
Any help with this endeavor would be great.
Thanks
Dim currentColumn As Integer
Dim columnHeading As String
For currentColumn = Sheets("SLTData").UsedRange.Columns.Count To 2 Step -1
columnHeading = Sheets("SLTData").UsedRange.Cells(10, currentColumn).Value
'CHECK WHETHER TO KEEP THE COLUMN
Select Case columnHeading
Case "PD.G0100", "PD.G0500", "PD.G0800", "PD.G0900", "PD.G1000", "PD.G0300", "PD.G0400", "PD.G0150", "PD.G0600"
'Do nothing
Case Else
If InStr(1, _
Sheets("SLTData").UsedRange.Cells(10, currentColumn).Value, _
"Homer", vbBinaryCompare) = 0 Then
Sheets("SLTData").Columns(currentColumn).Insert
For i = 11 To Cells(Rows.Count, "B").End(xlUp).Row
Range("G" & i) = WorksheetFunction.Sum(Range("B" & i), Range("C" & i), Range("D" & i), Range("E" & i), Range("F" & i))
Next i
End If
End Select
Next
Instead of Range("G" & i) use Cells(row, column) (both row and column are integer). To sum up the 5 cells left of it: Cells(row, column) = WorksheetFunction.Sum(Range(Cells(row, column-5), Cells(row, column-1)))
Related
New to VBA so go easy on me.
I have a spreadsheet in the below format:
I require VBA that will search column B for the term "LBR-0001", then replace the contents of column D in that row with the value "25", and column E in that row with "AUD". The row containing "LBR-0001" will change so this cannot be hard coded to a particular row.
Currently I am using the code below but it is far too slow to complete since it searches up to 10,000 rows.
For i = 1 To 10000
With Sheets("LPP_Previous_Month")
If .Range("B" & i).Value = "LBR-0001" Then _
.Range("D" & i).Value = "25"
.Range("E" & i).Value = "AUD"
End With
Next i
Any improvements would be greatly appreciated.
Use the worksheet's Match function to quickly locate a matching row in column B. Use that row number to set the values in columns D and E.
dim m as variant
With Sheets("LPP_Previous_Month")
m = application.match("LBR-0001", .range("B:B"), 0)
if not iserror(m) then
.cells(m, "D") = 25
.cells(m, "E") = "AUD"
end if
End With
Use Application.Match (not worksheetfunction.match) and return the result to a variant. This is the only way to reliably test using IsError.
I have a series of matrices consisting of 7 columns with a varied number of rows. I want the company names that are in column 2 of the matrix if the corresponding data in column 4 is "CM" aggregated into one cell per matrix (lets say B3:B98 for all the different matrices) with a space in between the different names. Please see the below picture for an example of what the matrices look like
The end result is that all the company names in Column E will be aggregated in B3 if the cell on the same row in column G is "CM", the next matrix beginning in Column M in B4 and so on.
I am having zero success in getting my if statement to recognize "CM" in the cell content, or aggregating the results using the Join statement. Any help is much appreciated.
Edits:
The objective is to have all the underwriters on a particular security aggregated in one cell, so that the cell can be easily searched in another part of the sheet for the presence of a particular underwriter.
The code below, as you can likely tell, does not work. I hit a wall as I could not get it to distinguish between cells that contained "CM" and those that did not. (I know that the code below would not aggregate the result in any cell, only copying the result into column B, as I said, it is a work in progress that has stalled.)
Dim Ws5 As Worksheet: Set Ws5 = Worksheets(5)
'turn off some Excel functionality so code runs faster
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'Compiles the managers in the matrices into a column on the MgrMatrix sheet to be used
'for the entry sheet column of underwriters.
Dim CoL As Range: Set CoL = Ws5.Range("D3:K104")
Dim CeL As Range
For Each CeL In CoL.Columns(4)
If CeL.Text = "CM" Then
CeL.Offset(0, -5) = "CM"
Else
CeL.Offset(0, -5) = CeL.Offset(0, -2).Value
End If
Next
Edit: Using urdearboy's code, i modified it to work for multiple matrices on the same sheet in the below way. This version doesn't have the same finesse as his did, as this version relies on all matrices containing the same number of columns and not exceeding 100 rows.
For i = 7 To 857 Step 9
For y = 3 To 100
If Cells(y, i) = "CM" Then
s = s & Cells(y, i).Offset(0, -1).Value & " "
End If
Next y
If s = "" Then
s = "Sole Lead"
End If
Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = Trim(s)
s = ""
Next i
Paste code in VBE within Sheet 5 (Or whatever sheet you want to run this on).
The string, s, will build itself as it loops through your column checking for "CM" matches.
As is, the code will add commas between each new value added like, so, and, so, and then remove the last coma at the end before displaying the final string like, so, and, so
Option Explicit
Sub TextCM()
Dim i As Long, s As String
For i = 3 To Range("G" & Rows.Count).End(xlUp).Row
If Range("G" & i) = "CM" Then
s = s & Range("E" & i).Value & ", " 'Remove & ", " if you do not want the comma + space
End If
Next i
Range("B2") = Left(s, Len(s) - 2) 'Change to Range("B2") = s to not delete last character in string
End Sub
You should be able to figure out how to extend this to multiple tables (matrices?) no problem.
Can I get some help with this macro. I want to go through all values in column P of a table in 'Sheet1'. Here is a picture of the table:
First Table
If value is <1 I want to copy paste the values in columns with the headings in the picture to a table in an 'explanation' sheet in the following format:
Second Table
Any help with this would be appreciated
On the sheet you want the data to go into (table 2) and under your header (in table 2) set the cell equal to the cell you want from table 1. Do this by entering pressing "=" and then clicking to the sheet with table 1 and click on the cell on the first row. Repeat this for the Name, Identifier, Sector, Rate... Once you have the first row done, highlight the cells on the second row and click and hold the bottom right of the black out line and drag down to the same number of rows from table 1.
If you want the values pasted there, then highlight the range and copy and right click paste > paste special (click on paste special) and select values.
Then you can sort the data based on the explanation sheet by the column that's value you need to be less than 1 and delete the rows that are greater than 1.
I have no idea what columns you want copied as they are not named in the first table image you have, so I just did up a macro that you can adjust the ranges yourself as you need copied and to what sheet you need.
The below code loops through your data, checks if the data in Column P for each row is less than 1 and puts the data into a variable where you can copy and paste to where ever you need that data,
The code,
Sub d()
Dim i As Long
Dim lastrow As Long
Dim rng As Range
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Range("P" & i).Value < 1 Then
If Not rng Is Nothing Then
Set rng = Union(rng, Range("B" & i), Range("C" & i), Range("D" & i), Range("Q" & i), Range("H" & i), Range("I" & i), Range("P" & i))
Else
Set rng = Union(Range("B" & i), Range("C" & i), Range("D" & i), Range("Q" & i), Range("H" & i), Range("I" & i), Range("P" & i))
End If
End If
Next
rng.Copy Sheets("explanation").Range("A2")
End Sub
See if this does not help any?
I apologize for all the text, but this is a little complex and I wish to avoid confusion:
I need code that will insert one empty row when two consecutive cells in a column are the not the same (e.g., If H2 <> H3, then insert an empty row beneath row 2). However, it must also be able to insert two empty rows when any two or more consecutive cells in a column are the same (e.g., If H4 = H5, then insert two empty rows beneath H5, or if H4 = H5 = H6, then insert two empty rows beneath H6.)
The point is to have one empty row separating all data-containing rows in which the value in column H is not the same, and to have two rows beneath groups of rows in which the value in column H is the same. That leaves an extra empty row beneath the group so the extra empty row can contain a sum of the group's values in column P.
I have figured out how to do the first task with this code:
Sub SepFcpDs()
Application.ScreenUpdating = False
Dim LastRow As Integer
'Search code
LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim i As Long
'Begin loop code
For i = 2 To LastRow
'Insert an empty row if FcpDs do not match
If (Range("H" & i) <> Range("H" & i).Offset(1)) And Not IsEmpty(Range("H" & i)) Then
Range("H" & i).Offset(1).EntireRow.Insert
End If
Next i
Application.ScreenUpdating = True
'End loop code
End Sub
I cannot figure out how to make it find groups of rows, which may be of any size, in which groups of rows in column H are the same, and then to insert an extra row beneath these groups. I have tried modifying the code above as such:
If (Range("I" & i) = Range("I" & i).Offset(-1)) _
And (Range("I" & i) = Range("I" & i).Offset(-2)) And Not IsEmpty(Range("I" & i)) Then
Range("I" & i).EntireRow.Insert
End If
This code does not work (returns Run-time error '1004': Application-defined or object-defined error). How do I fix this?
This will do the trick.
Sub SepFcpDs()
Application.ScreenUpdating = False
Dim LastRow As Integer
Dim LastRowWithValue As Integer
Dim Column As String
ColToSearch = "H"
'Search code
LastRow = ActiveSheet.Cells(Rows.Count, ColToSearch).End(xlUp).Row
Dim i As Long
'Begin loop code
LastRowWithValue = LastRow
For i = LastRow To 3 Step -1
'Insert an empty row if FcpDs do not match
If (Range(ColToSearch & i) <> Range(ColToSearch & i).Offset(-1)) Then
If i <> LastRowWithValue Then
Range(ColToSearch & (LastRowWithValue + 1)).EntireRow.Insert
End If
Range(ColToSearch & i).EntireRow.Insert
LastRowWithValue = i - 1
End If
Next i
Application.ScreenUpdating = True
'End loop code
EDIT: Updated to work even if there are multiple groupings of the same value in the column. This won't deal with the next column if you have different requirements, but should at least be a start.
I have this code:
Dim first As Integer
Dim Last As Integer
Dim i As Integer
For i = 1 To 17
first = (ActiveCell.Row + 1)
Selection.End(xlDown).Select
Last = (ActiveCell.Row - 1)
Range("J" & first & ":J" & Last).Select
Selection.Value = "=J$" & (first - 1)
Range("A" & Last + 1).Select
Next i
and would like to be able to replace the 17 with a variable because some of the workbooks have an extra group. I can't just count the number of rows as there is information between first and last but in different columns.
Is there a way to count the number of cells that have data in a set column where the data may not be contiguous (then I can replace the 17 with a variable that is equal to variable -1)?
Found it online: Thanks.
n = Worksheets("Sheet1").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count