I have been trying to figure this problem out for a while but I cannot think of an answer. Some context here: I have two worksheets. In sheet one, I have a column that is full of names. In the second sheet, I have an outline that has 10 rows that display the names. However, if in sheet one there are 11 names, the 11th name would not appear in sheet two because there are only 10 rows. What I need to figure out is how to insert a row for the 11th names (or nth depending on how many names are added). Once I add the nth row, I would auto fill the formula down which is the easy part. The part I cannot figure out is how to insert the row.
What I was thinking was inserting a COUNT function that would count the different names and insert the rows that way. But is there a way I could do it so there would not be a random number (the number being the COUNT) in a cell in one of my worksheets?
From my understanding, you want to insert n-10 number of rows with n being total number of rows of names.
Try this
Sub test()
Dim startr, endr As Range
Set startr = Range("A7") 'Set this to be the first row of your list of names
If Not startr.Value = "" Then
With Sheets("Sheet1")
Do Until startr.Offset(i).Value = ""
i = i + 1
Loop
End With
Set endr = startr.Offset(i - 1) 'endr is now the last row of the names
totalr = Range(startr, endr).Rows.Count 'totalr is the total number of rows/names
If totalr > 10 Then
addr = totalr - 10 'addr is the number of rows you need to add
MsgBox "You need to insert " & addr & " more rows."
'The following finds the last row of column A and inserts addr number of rows
Dim lastr As Range
Set lastr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)
lastr.Offset(1).EntireRow.Resize(addr).Insert
Else
MsgBox "Number of rows/names is " & totalr & " which is less than 10, so no rows are being added."
End If
Else
MsgBox startr.Address(0, 0) & " is empty."
End If
End Sub
Related
I use a lot of tables in my code
My table is somewhere in my worksheet.
I know I can go to the first cell with the following code:
Worksheets("sheet").ListObjects("table").Range.Cells(1, 1).Activate
But I would like to store the row and column number in 2 integers ie. column = 3 and row = 4 if first cell of table is C4.
Worksheets("sheet").ListObjects("table").Row and Column are not working unfortunately
This prints the row and the column of the first cell of the table:
Public Sub TestMe()
Dim tbl As ListObject
Set tbl = Worksheets(1).ListObjects("Table1")
Debug.Print tbl.Range.Cells(1, 1).Row
Debug.Print tbl.Range.Cells(1, 1).Column
'As a bonus:
Debug.Print tbl.Range.Rows.Count 'total number of rows
Debug.Print tbl.Range.Columns.Count 'total number of columns
End Sub
Very dirty way, using your code, which is activating the Cells(1,1):
Debug.Print ActiveCell.Row
Debug.Print ActiveCell.Column
You're nearly there. You need:
Worksheets("sheet").ListObjects("table").Range.Cells(1, 1).Row
... to return the absolute row number within the spreadsheet, of your table's first row.
Obviously, the same syntax to return the column number.
I have two headers in two rows in my excel based on which i upload values for each row. if the combination of two headers is already available, the values will be updated in that row. If that combination is not available a new column will be created.
Sample Excel
As in the image, If i find Column 2 and Column B combination again i can update value in a new row against Column 2 and Column B. If there is another combination of headers say, Column 5 and column B, then it will create a new column.
Using VBA i am able to check only one column header but not the combination of the headers. i used the below code.
Set c=ws.Range("B2",ws.Cells(2,Columns.Count)).Find:=What(d,1)
IF c is Nothing Then
My code
Else`My Code End If
Find can't be used to find values spread over several cells. I suggest this kind of code.
Private Sub FindMatchingColumn()
' 24 May 2017
Dim Caption1, Caption2
Dim Combination As String
Dim Captions As String
Dim C As Long
Caption1 = "Column A"
Caption2 = "Column 1"
Combination = CStr(Caption1) & CStr(Caption2)
With ActiveSheet
Do
C = C + 1
Captions = CStr(.Cells(1, C).value) & CStr(.Cells(2, C).value)
If StrComp(Captions, Combination, vbTextCompare) = 0 Then Exit Do
Loop While Len(Captions)
If Len(Captions) Then
MsgBox "Column " & C & " has matching captions"
Else
MsgBox "No matching captions were found" & vbCr & _
"Write new captions to Column " & C
.Cells(1, C).value = Caption1
.Cells(2, C).value = Caption2
End If
End With
End Sub
Caption1 and Caption2 are the two column headers you are looking for. The first part of the code loops through all the columns to find that combination. If it is found it passes the column where it was found to the following code. If not, it passes the number of the next blank column.
The second part takes that column number and acts upon it. If it is a used column you can add your value there. If it is a new column it adds the two captions and then you can add your values in it.
This code presumes that you know the sequence of the captions. If you need to accept either A + B or B + A both values must be checked before passing to the next column in the Do loop.
I have two columns with data as double.
I'd like to create a vba script that does this:
Create a temporary third column that stores a lower value of each row.
Output min and max of the third column.
Now the problem is not to create this third column, I'd like this operation to be done in memory.
Please help
Thanks
This will show a message box with minimum and a message box with maximum value, assuming the two columns are A and B.
Sub MinMax()
' Count the number of rows in the first column
' Assuming that number of rows in second column equals those in the first column
HowFar = WorksheetFunction.CountA(Range("A:A"))
' Declare an array to store the minimums
Dim Arr() As Double
ReDim Arr(HowFar - 2)
Dim Index As Integer
Index = 0
' Loop through the first and second columns and store the minimums for each row in the array
Dim i As Integer
For i = 2 To HowFar
Minimum = Application.WorksheetFunction.Min(Range("A" & i & ":B" & i))
Arr(Index) = Minimum
Index = Index + 1
Next i
' Get the minimum value in the array
Min = Application.WorksheetFunction.Min(Arr)
' Get the maximum value in the array
Max = Application.WorksheetFunction.Max(Arr)
' MsgBox the two values
MsgBox ("Minimum = " & Min)
MsgBox ("Maximum = " & Max)
End Sub
I'm searching for a VBA macro for Excel, which can detect the word "mean", in column A. After this it would copy the yellow row with the formula in C to J.
The formula counts the average from one row after the last "mean" to the next =AVERAGE (C1323:C1437)
after every sixth mean there also needs to be Area and 150 copyied two rows after mean and I and J Need to be changed. Consequently I and J would refer to the cell A1441 in this case (=G1439/C1439*$A$1441) till the end of the file.
I'm not quite sure if it's easy or not but I'm totally overchallenged. I would be very thankful for help.
Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+q
strSearchWord = "Mean"
i = Application.WorksheetFunction.CountIf(Range("A:A"), strSearchWord)
Y = 2
For x = i To 0
i = Application.WorksheetFunction.Match(strSuchWort, Range("A:A"), 0)
Range("C" & i).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" ' that's still wrong, should be something like i-y?
Selection.AutoFill Destination:=Range("C" & i:"J" & i), Type:=xlFillDefault
Range("CY:JY").Select
i = Y
'for each fifth i
'Range("A" & i + 3).Select
' ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-6]*R2159C1"
Next x
End Sub
it's still wrong, but my first draft.
#stucharo the Area correction is difficult to describe I've added a better Picture with formulas. I hpe that now it's understandable
If your line ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" needs to change the number of rows betwen means each time then you'll need to add a variable as you comment suggests. Also, just writing the string to the cells value (ActiveCell.Value) means that you will see it written as a formaula when you click the cell in the workbook (and it'll highlight the range etc.). You could try replacing it with:
ActiveCell.Value = "=AVERAGE(R[" & i - Y & "]C:R[-1]C)"
although since I can't see the first row of your sheet I'm not certain that'll give you the correct range of rows each time.
If your row number is likely to change and you are copying over the same number of columns each time then it might also be just as easy to write the formula directly to cells within a loop, rather than explicitly copying it.
Adding text after every 6th "mean" would require you to keep count of how many means had passed so far. This can be done by incrememnting a counter variable and using the Mod operator will tell you the remainder after a division. Therefor numberOfMeans Mod 6 will give you the remainder when divided by 6 and when this equals zero you know you have a multiple of 6. I've tried to capture all this into the code below.....
Sub Test()
Application.ScreenUpdating = False
Dim startRow As Integer
startRow = 2
Dim endrow As Integer
endrow = Range("A2").End(xlDown).row
Dim lastMeanRow As Integer
lastMeanRow = startRow - 1
Dim areaRow as Integer
areaRow = lastMeanRow + 3
Dim meanCounter As Integer
meanCounter = 0
Dim avgColHeight As Integer
Dim col As Integer
Dim row As Integer
'Check each row in the sheet
For row = startRow To endrow
'Cols i and j in every row need to be modified
For col = 9 To 10
Cells(row, col).Value = "=RC[-2]/RC[-6]*R" & areaRow & "C1"
Next col
'If column 1 of that row contains "mean" then
If Cells(row, 1).Value = "mean" Then
'Calculate the column height to average over....
avgColHeight = row - lastMeanRow - 1
'...and loop through each of the columns....
'(including i and j to add average)
For col = 3 To 10
'....inserting the averaging formula.
Cells(row, col).Value = "=AVERAGE(R[-" & avgColHeight & "]C:R[-1]C)"
Next col
'Then increment the counter to keep track of the number of means
meanCounter = meanCounter + 1
'If the number of means is a multiple of 6 then
If (meanCounter Mod 6 = 0) Then
'insert the "Area" and "150" strings
Cells(row + 2, 1).Value = "Area"
Cells(row + 3, 1).Value = "150"
areaRow = row + 3
End If
'Finally change the lastMeanRow to the mean row we have just processed.
lastMeanRow = row
End If
'Do it again until we reach the end of the data
Next row
Application.ScreenUpdating = True
End Sub
I also noticed your point on the value of area changing periodically. Writing this programatically, as above, will aloow you to add some logic over the value of "Area" and when it changes.
You clearly have a long list of data and want to automate the creation of the rows and formulas you describe.
It is possible write VBA to scan through the data and modify the formulas etc but first I would question if this is the best approach to give you what you need.
Excel has a feature called "pivot tables" which essentially allows you to summerise data in a list.
for instance if the list had one row for each city in the world and gave the population in the city, and a column gave which country it was in. A pivot table could be used to create the average population for a country of the countries cities. I suspect you are doing this sort of thing.
If you don't know about pivot tables you should find out about them. See here
In your case your mean row is summeriseing data in the rows above it. To use pivot tables you would have to have a column that defined which group each row is in. You pivot table would sue this column as a row summary and you would then create the average for all the other column.
#Nathalie. It's hard to help without knowing more. eg Is the data delivered with the mean text already inserted. It looks like column A has a number the represent the row number within the group (and this could be used by a formula to create the "Group Name" column you need for pivot tables.
You can get the pivot tables to do the area adjustment by:
Creating a new set of columns which contains formulas that cause the values in columns C to J to be copied except for when it is the 6th set of data in which case you adjust the values in C to J accordingly).
You probably need to introduce columns that:
A. give the "group name"
B. give a count of which group it is in so every 6th you can do the adjustment you need.
4 by using pivot tables and basic techniques you will find it easie rot update the refresh the data, should you need to.
I have multiple spreadsheets that each roughly look like this:
I'm trying to find a way to go through each of the SPEAKER HEADERS in Row 1, and summarize the scores that are associated with the corresponding survey question ("Was the CONTENT good? Was the SPEAKER relevant? What the DELIVERY good?) grouped by color.
I can't think of a clever way of doing this automatically.
I can get the RANGE SPANS of the Merged Cells like this:
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
MsgBox Cell.MergeArea.Address
End If
Next
I then need to iterate over the range provided by the address, getting the numerical values in all the rows BELOW that range.
For example, running the current macro produces this:
I need to take $C$1:$E$1 and run a for loop that say FROM C1 to E1 average all the numbers in the rows below it. I have no idea how to do this.
I was thinking about augmenting the selection in include everything used
Is there a better way to do this?
This is the tragically bad way I'm doing it now (which I'm quite proud of on account of being new to excel):
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
Set rng = Range(Cell.MergeArea.Address) 'Equal to the Address of the Merged Area
startLetter = Mid(rng.Address, 2, 1) 'Gets letter from MergeArea Address
endLetter = Mid(rng.Address, 7, 1) 'Gets letter from MergeArea Address
On Error GoTo ErrHandler:
Set superRange = Range(startLetter & ":" & endLetter)
ErrHandler:
endLetter = startLetter
Set superRange = Range(startLetter & ":" & endLetter)
Resume Next
superRange.Select
MsgBox Application.Average(Selection)
In order to get rid of the error you are having, you need to change:
Set rng = Cell.MergeArea.Address
to
Set rng = Range(Cell.MergeArea.Address)
Ideally, this data would be better stored in a database so that it could be queried easily. If that's not an option, then the way you are going at it in Excel is as valid as most any other approach.
EDIT
Once you obtain the address of the left-most column for each of your speakers, you can loop through each column to obtain averages.
'Number of columns in the current speaker's range.
numColumns = rng.Columns.Count
'First row containing data.
currentRow = 4
'First column containing data.
firstColumn = rng.Column
'Loop through each column.
For col = firstColumn to firstColumn + (numColumns -1)
totalValue = 0
'Loop through each row.
Do While Cells(currentRow,col).value <> ""
totalValue = totalValue + Cells(currentRow,col).Value
currentRow = currentRow + 1
Loop
averageValue = totalValue / (currentRow - 3)
'Reset the currentRow value to the top of the data area.
currentRow = 4
'Do something with this average value before moving on to the next column.
Next
If you don't know what row is the start of your data, you can keep checking every row below rng.Row until you hit a numeric value.
The method above assumes that you have no blank entries in your data area. If you have blank entries, then you should either sort the data prior to running this code, or you would need to know how many rows you must check for data values.