I have a worksheet, i need deleted all rows that not contain the phrase "#" on column G until column K.
This is sample data i have
if cell on Column G until Column K not containing "#", Delete Rows
please help me..
You will have to use several loop commands. Begin by looping through the records that you want to process. Here is an outline of pseudo-code.
loop through the columns that you want to process, G through K
read the value of the cell as a string
initialize variable atdetector = "dunno_yet"
loop through each character of the string
if any character = "#"; then atdetector = "found"
After looping through each column, if atdetector = "dunno_yet", then "#" was never found. Delete the row. Repeat until there are no more rows.
The following macro scans from row 2 and removes rows where columns 2-5 do not contain an #:
Sub Macro1()
CurRow = 2
While CurRow < Application.WorksheetFunction.CountA(Range("A:A")) + 1
If InStr(1, _
Sheet1.Cells(CurRow, 2) _
& Sheet1.Cells(CurRow, 3) _
& Sheet1.Cells(CurRow, 4) _
& Sheet1.Cells(CurRow, 5), _
"#", vbTextCompare) Then
Else
Sheet1.Rows(CurRow & ":" & CurRow).Delete Shift:=xlUp
CurRow = CurRow - 1
End If
CurRow = CurRow + 1
Wend
End Sub
Using Instr, we concatenate the columns of interest (2-5 in my example code above) to create a single string of text. Then we search for # within that concatenated string and remove accordingly.
It changes
into
Alternatively, you can create an additional column containing the following formula:
FIND is used to identify whether an # exists within one of the preceding cells, print No if not and Yes if it does. Now you can filter these elements (No), select the range (making sure only the visible cells are selected), delete the rows and remove the filter.
Related
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.
Can anyone solve this?
Sub test
Dim i as integer
For I = 1 to 10
ActiveCell.Offset(0, 2).Formula = "=Sum(E15,&i&)"
Next I
End Sub
your actual goal is unclear
you may want to start form this code
Sub test()
Dim i As Integer
For i = 1 To 10
cells(i, 4).Formula = "=Sum(E" & i & ":E15)"
Next
End Sub
and adjust it to your needs, knowing that:
it currently writes in cells "D1:D10"
since cells(i, 4) references a cell in 4th column (i.e.: column "D") 4 and i row, and we're inside a loop where i is looping through 1 to 10
so if:
you want to reference a different column then just change 4 to the proper column index
you want to reference a different row then just change i to the proper row index (may be some i+2 if you need to iterate through 1 to 10 but start writing from row 3)
the formula written in those cells is:
=SUM(E1:E15) in D1,
=SUM(E2:E15) in D2,
....
=SUM(E10:E15) in D10.
so just change "=Sum(E" & i & ":E15)" to your actual needs
You're close, trying to use ampersands (&) to concatenate strings.
ActiveCell.Offset(0, 2).Formula = "=Sum(E15," & i & ")"
Use the ampersands between strings to merge them, not inside strings.
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'm using INDEX and MATCH functions to pull data which is concatenated string of G2 and H2 from column D (sorry I don't have enough points to attach pic). Column D has INDEX(column A and column B) and columns A and B have values till 12th row. MATCH is working fine giving me the position as 6 on the worksheet. But when I use this in VBA code as shown below,INDEX is working in the VBA code (can be seen through MsgBox) but MATCH function which would allot value to the variable 'check' isn't working. I have been breaking my head for really long. Need help from experts here. Somebody please tell me where am I going wrong?
Sub testindex()
Dim check As Long
Set sh = Sheets("Sheet1")
For j = 1 To 11
'Index value is correctly shown
MsgBox "Index Value=" & Application.WorksheetFunction.Index(sh.Range("A2:B12"), j, 1) & Application.WorksheetFunction.Index(sh.Range("A2:B12"), j, 2)
'Cells(7, 4)=ISA737775 same as G2&H2
MsgBox "Cells(7,4)=" & Cells(7, 4)
check = Application.WorksheetFunction.Match(Cells(7, 4), Application.WorksheetFunction.Index(sh.Range("A2:B12"), j, 1) & Application.WorksheetFunction.Index(sh.Range("A2:B12"), j, 2), 0)
Next j
End Sub
Thanks
Match expects the second paramater to be in the form of a range. When you call match through VBA that range actually needs to be a range object, not just some string like "A1:A12" or whatever it is that your concatenated Index formulas output.
At any rate, you are iterating already, so why not just call those values directly instead of pulling their values through Index?
check = Application.WorksheetFunction.Match(Cells(7, 4), sh.Range("A" & 2 + j).value & sh.Range("B" & 2 + j), 0)
Which is writing the same exact thing but without having to use a taxing INDEX function in VBA to do it. Note that this still won't work because the second parameter of match is still just a string which is a concatenated value from Column A and Column B. You could convert to a range by sticking them in the range object with:
check = Application.WorksheetFunction.Match(Cells(7, 4), sh.Range(sh.Range("A" & 2 + j).value & sh.Range("B" & 2 + j)), 0)
I'm assuming that the values in A and B are actual cell names that when concatenated will make a range. Like when j=1 then the it would be like check=Match(Cells(7,4), sh.Range("G2:H50"), 0) or something...
I need a vba script or help on what I'm writing in order not to exit the iteration when the table contains vertically and horizontally merged cells.
Example of the table:
---------
| | | <-- I don't want these rows deleted, they can be skipped
|---| |
| | | <-- I don't want these rows deleted, they can be skipped
|---|---|
| | | <-- this must be checked for emptiness in order to decide to delete or not
|---|---|
| | | <-- this must be checked for emptiness in order to decide to delete or not
|---|---|
My script in VBA so far:
Public Sub DeleteEmptyRows()
Dim c As String
c = ""
Dim oTable As Table, oRow As Integer
' Specify which table you want to work on.
For Each oTable In ActiveDocument.Tables
For oRow = oTable.Rows.Count To 1 Step -1
'On Error GoTo NextIteration
MsgBox oTable.Rows(oRow).Range.Text
'If Len(oTable.Rows(oRow).Range.Text) = oTable.Rows(oRow).Cells.Count * 2 + 2 Then
If Len(Replace(oTable.Rows(oRow).Range.Text, Chr(13) & Chr(7), vbNullString)) = 0 Then
oTable.Rows(oRow).Delete
End If
Next oRow
Next oTable
MsgBox c
End Sub
How to reproduce the error:
Create a 5x5 table. Select cell(0,0) and cell(1, 0) and merge them. Select cell(0, 1) and cell(0, 2) and merge. Run the script and get the 5991 error..
The problem is that I get a run-time error 5991: Can't access to individual lines in this collection because there are vertically merged cells.
I really don't know what to do because if this error happens no row will be looked after. Usually my tables have a header that has vertically merged cells and the body rows are not, so I cannot do anything...
for Word.
This is what I came up with to delete all rows in a table which do not contain any merged cells and do not contain any text.
The problem with tables containing merged cells is not so much deleting the rows but identifying which cells are actually merged and then removing whats left.
The way I approached this was to loop through all the cells in table and for each row workout how many columns are counted (horizontally merged cells and cells vertically merged from above are ignored) and thanks to this page (http://word.mvps.org/FAQs/MacrosVBA/GetRowColSpan.htm)
if any of the cells in the row are the top of a vertically merged cell we can tell.
Finally we also check if there is any text in the row.
This is the code I came up with, hopefully with the comments it should be straightforward. Unfortunately due to the way Word deals with this stuff the cells have to Selected rather than just using ranges - this isn't ideal because it significantly slows things down. It has worked in all my tests.
Option Explicit
Public Sub DeleteEmptyRows()
Dim oTable As Table, oCol As Integer, oRows As Integer
Dim iMergeCount() As Integer, dCellData() As Double
Dim MyCell As Cell
Dim iCurrentRow As Integer, iRowCounter As Integer
'Watching this happen will slow things down considerably
Application.ScreenUpdating = False
' Specify which table you want to work on.
For Each oTable In ActiveDocument.Tables
'We need to store the number of columns to determine if there are any merges
oCol = oTable.Columns.Count
ReDim dCellData(1 To oTable.Rows.Count, 1 To 3)
'The first column will count the number of columns in the row if this doesn't match the table columns then we have merged cells
'The second column will count the vertical spans which tells us if a vertically merged cell begins in this row
'The third column will count the characters of all the text entries in the row. If it equals zero it's empty.
iCurrentRow = 0: iRowCounter = 0
For Each MyCell In oTable.Range.Cells
'The Information property only works if you select the cell. Bummer.
MyCell.Select
'Increment the counter if necessary and set the current row
If MyCell.RowIndex <> iCurrentRow Then
iRowCounter = iRowCounter + 1
iCurrentRow = MyCell.RowIndex
End If
'Check column index count
If MyCell.ColumnIndex > VBA.Val(dCellData(iRowCounter, 1)) Then dCellData(iRowCounter, 1) = MyCell.ColumnIndex
'Check the start of vertically merged cells here
dCellData(iRowCounter, 2) = dCellData(iRowCounter, 2) + (Selection.Information(wdEndOfRangeRowNumber) - Selection.Information(wdStartOfRangeRowNumber)) + 1
'Add up the length of any text in the cell
dCellData(iRowCounter, 3) = dCellData(iRowCounter, 3) + VBA.Len(Selection.Text) - 2 '(subtract one for the table and one for cursor(?))
'Just put this in so you can see in the immediate window how Word handles all these variables
Debug.Print "Row: " & MyCell.RowIndex & ", Column: " & MyCell.ColumnIndex & ", Rowspan = " & _
(Selection.Information(wdEndOfRangeRowNumber) - _
Selection.Information(wdStartOfRangeRowNumber)) + 1
Next MyCell
'Now we have all the information we need about the table and can start deleting some rows
For oRows = oTable.Rows.Count To 1 Step -1
'Check if there is no text, no merges at all and no start of a vertical merge
If dCellData(oRows, 3) = 0 And dCellData(oRows, 1) = oCol And dCellData(oRows, 2) = oCol Then
'Delete the row (we know it's totally unmerged so we can select the first column without issue
oTable.Cell(oRows, 1).Select
Selection.Rows.Delete
End If
Next oRows
Next oTable
Application.ScreenUpdating = True
End Sub
You should check in your conditions Range.MergeCells property, which will return TRUE in case cells in the range are merged.