Hello I'm trying to delete all the rows where in column B the members value is over 1000.
I tried this step by step and tried first getting rid of all the unecessary data from B cells and leave just the line with the members.
I noticed there are 5 lines and the members line is the 6'th one. I searched for hours and I still don't get it HOW TO DELETE THE FIRST 5 LINES. Could you please offer me a hand of help? Im sure its soo easy but I cant find it.
I have this:
Option Explicit
Sub Delete5TextLines()
Dim c As Range, s
Application.ScreenUpdating = False
For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
**********
Next c
Application.ScreenUpdating = True
End Sub
this is the .csv file:
http://we.tl/vNcyfg9Wus
Alright, this is not very elegant, but the first thing that I came up with, that kinda works.
use this formula to delete the last word in your bulk of text ("members")
Assuming your text is in A1:
=LEFT(A1,FIND("|",SUBSTITUTE(A1," ","|",LEN(A1)-LEN(SUBSTITUTE(A1," ",""))))-1)
This formula gets you the last word of a text, in this case the number of members (because we deleted the word "members)
Assuming you put the formula above in A2
=IF(ISERR(FIND(" ",A2)),"",RIGHT(A2,LEN(A2)-FIND("*",SUBSTITUTE(A2," ","*",LEN(A2)-LEN(SUBSTITUTE(A2," ",""))))))
Now you should have extracted the number of members. If this value is <5000 you can delete the row with a vba loop that should look like this:
Sub deleteRowsAfterMembers
Dim i as Integer
i = ThisWorkbook.Sheets(1).Rows.Count
While i > 0 Do
If (CellWithMemberCount).Value < 5000 Then
ThisWorkbook.Sheets(1).Rows(i).Delete
End If
i = i-1
Loop
End Sub
That'll (hopefully) do it.
Whenever you delete entire rows using a loop, you should start at the bottom of the range and work the loop upwards.
EDIT#1:
Assuming that there are at least five lines within a cell and the lines are separated by Chr(10) then this will remove the first 5 lines:
Sub marine()
ary = Split(ActiveCell.Value, Chr(10))
t = ""
For i = 5 To UBound(ary)
t = t & Chr(10) & ary(i)
Next i
If Len(t) > 1 Then
t = Mid(t, 2)
Else
t = ""
End If
ActiveCell.Value = t
End Sub
Related
I am new to macros in Excel, and I’m trying to speed up a process. I need to add a varying number of blank rows, if certain text is present in the cell above it. Not equal, but containing.
For example if A1 contains 'Apples', add two blank rows beneath. If A6 has 'Plums', add four blank rows beneath, etc.
What I have now is this:
For a=1 To ActiveSheet.Cells(Rows.Count,1).End(x1Up).Row
If ActiveSheet.Cells(a,1).Value = “Apples” Then
ActiveSheet.Rows(2).Insert
a = a+1
ELSE
If ActiveSheet.Cells(a,1).Value = “Plums” Then
ActiveSheet.Rows(4).Insert
a = a+1
End If
End Sub
So far I've gotten a Compile Error, stating "Block If without End If" though I believe I closed them both. I'm not sure if I'm correctly comparing or searching for a string as well (referring to my use of ="Apples"), but cannot get it to run at all to test that part.
For a = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If TypeName(ActiveSheet.Cells(a, 1)) = "String" Then
If ActiveSheet.Cells(a, 1).Value = "Apples" Then
ActiveSheet.Rows(2).Insert
a = a + 1
ElseIf ActiveSheet.Cells(a, 1).Value = "Plums" Then 'One error here
ActiveSheet.Rows(4).Insert
a = a + 1
End If
End If
Next 'And here too
Column 'P' ("P6:P3000") holds a value as such "EMPLOYEE_CONTRACT_STATUS_Closed". I am trying to pull the "Closed" (could also be "Open") portion out of the cell into column 'Q' or just replace the existing column 'P' value with the last text after the delimiter ("_")... "EMPLOYEE_CONTRACT_STATUS_Closed" --> "Closed" or "Open." This creates these steps:
Create new column Q
Insert new value in column header
Perform function in 'P' to either replace values or dump into column 'Q' ("Q6:Q3000")
Below I have what I have so far --> Code to create column and to call a function code to pull the last text after last delimiter... this is a part of an automated process so the goal is not to touch or manipulate any of the
cell values. I know there is possibly for a Subprocess to perform this but I cannot figure it out and keep scratching my head. This is my first time on the forum and for someone to supply a fixed code but also EXPLAIN the syntax behind it would be great because I am pretty experience with VBA, but have never ran into this process. THANKS ^_^
& 2. Creating new column and changing the header name:
Sub ContractStatus_Change()
Application.ScreenUpdating = False
Workbooks("DIV_EIB_Tool.xlsm").Worksheets("EIBMaintainEmployeeContractsW31").Range("Q5") _
.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Worksheets("EIBMaintainEmployeeContractsW31").Range("Q5").Value = "Contract Status"
Worksheets("EIBMaintainEmployeeContractsW31").Range("Q6:Q3000").NumberFormat = "General"
Application.ScreenUpdating = True
End Sub
My function to pull last text out from disclosed value:
Function RightWord(r As Range) As Variant
Dim s As String
s = Trim(r.Value)
RightWord = Mid(s, InStrRev(s, "_") + 1)
End Function
I have not run into an error yet, just do not know how to piece this together, under assumption I can probably run this all through one sub process but I am having a massive brain fart.
Try this code
Sub Test()
Dim a, i&
With Worksheets("EIBMaintainEmployeeContractsW31")
.Columns("Q").Insert
a = .Range("P6:P" & .Cells(Rows.Count, "P").End(xlUp).Row).Resize(, 2).Value
For i = LBound(a) To UBound(a)
If InStr(a(i, 1), "_") Then
a(i, 2) = Split(a(i, 1), "_")(UBound(Split(a(i, 1), "_")))
End If
Next i
With .Range("Q5")
.Value = "Contract Status"
.Offset(1, -1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
End With
End Sub
I started the code by dealing with the sheet EIBMaintainEmployeeContractsW31 so between With and End With you will notice some lines start with dot which refers to this worksheet. Then insert a column before column Q and stored the required range which is P6 to P & last row into an array (arrays are faster)
After that looping the array which holds two columns (one for the raw data and the other for the required output). Make sure of underscore existence using InSstr function then if it exists store into the second column the last part of the split output based on the underscore.
Finally populating the array into the worksheet.
Hope that explanation helps you.
I want to produce a mini report of several items matching a key. In my loop I get the keys returned but can't fathom out how I can access the data that I need in the report that is held in other columns.
I put in some msgbox's to trap the data and an escape mechanism to get out of the loop. These I have commented out below as well as the data lines that don't work. "cbdata" is a workbook named range covering B5:T4019. The report is being compiled on a different sheet (activesheet). For some unknown reason on looping through without outputing any data "r" gets updated to some spurious numbers like 2421 (first loop) this appears to be linked somehow to the data in "cbdata". The first entry is actually in row 2388 so it doesn't really correlate to an indexed row in the range. However, I think first of all I need to find out what I can do to get the corresponding row returned for each of my passes. "ky" returns all the entries in columns(19) but I'm only interested in those that match "ledcdeyr" which in this instance is "2012017" that bit works returning all the entries matching in the loop.
Having got the key information agreeing, how might I relate this to the row number so that I can extract the other data from that row.
(cr is vbcrlf)(r should be the row number of the receiving report)
Any pointers would be greatly appreciated.
Code:
r = r + 1 ' row 38 when entering process
For Each ky In Range("cbdata").Columns(19).Cells
'ans = MsgBox(ky & cr & r, vbOKCancel)
'If ans = vbCancel Then Exit Sub
If ky = ledcdeyr Then
ans = MsgBox(ky & cr & r, vbOKCancel)
If ans = vbCancel Then Exit Sub
Cells(r, 2) = Range("cbdata").Cells(ky, 1)
'Cells(r, 3) = Range("cbdata").Columns(2).Cells
'Cells(r, 4) = Range("cbdata").Columns(3).Cells
'Cells(r, 5) = Range("cbdata").Columns(4).Cells
'Cells(r, 6) = Range("cbdata").Columns(5).Cells
ans = MsgBox(r, vbOKCancel + vbQuestion, title)
If ans = vbCancel Then Exit Sub
End If
r = r + 1
Next
I am not entirely sure I follow but the Range object during the loop is ky. The row for that cell be retrieved with .Row property
ky.Row
Somewhat random example with a conditional test:
Option Explicit
Public Sub Test()
Dim ky As Range, counter As Long
Dim loopRange As Range
Set loopRange = ThisWorkbook.Worksheets("Sheet1").Range("cbdata").Columns(19)
For Each ky In loopRange.Cells
counter = counter + 1
If ky = 1 Then
Debug.Print ky.Row, counter
Debug.Print loopRange(counter).Address
End If
Next
End Sub
I ran the undernoted slightly amended code on my project but it produced some spurious results.
I had already tried the ky.row but when it didn't give me the information, I just thought that it wasn't the answer.
Public Sub Test()
Dim ky As Range, counter As Long
Dim loopRange As Range
'Set loopRange = ThisWorkbook.Worksheets("Sheet1").Range("cbdata").Columns(19)
Set loopRange = Range("cbdata").Columns(19) ' workbook range name
For Each ky In loopRange.Cells
counter = counter + 1
'ans = MsgBox(counter & vbCrLf & ky & vbCrLf & ky.Row, vbOKCancel)
'If ans = vbCancel Then Exit Sub
If ky = 2012017 Then
Debug.Print ky.Row, counter
Debug.Print loopRange(counter).Address
End If
Next
End Sub
The Debug results from running the above code for the first 4 records were:
2388 2384
$CNK$5:$CNK$4091
2408 2404
$COE$5:$COE$4091
2444 2440
$CPO$5:$CPO$4091
2450 2446
$CPU$5:$CPU$4091
The numbers on the left produced by ky.row are correct. The numbers on the right relate somehow to the counter which here should be 1, 2, 3, 4. This is the same situation that occurred with my "r" and hence didn't produce the information where I expected to see it. Which caused me to think that ky.row was not working. Also my range "cbdata" is B5:T4091 The rows are correct but the "CNK" etc - I don't know where that has come from.
I thought I'd just feed back to you where I'm at and your reply certainly made me look further, as I seemed to be going round in circles.
If you have any idea how the counter would be acting so spuriously then perhaps you could let me know. Having used your code on its own the that clears up any issue with there not being a problem with any other part of my code. Thanks again.
I would like to get the last modified date of a given list of files that I need to enter in column A of Excel . How can I fix this ? For each file , I want to get the last modified date. Unfortunately I haven't many skills in VBA .
That's easy! You can apply FileDateTime ( file_path ). If you have file patch & name list in column A, and this macro will return the date & time of when a file was created or last modified in column B.
Sub LastFileDateTime()
CNT = Range("A65536").End(xlUp).Row
For i = 1 To CNT
Cells(i, "B").Value = FileDateTime(Cells(i, "A"))
'FileDateTime("D:\QueryTable.xlsm")
Next
End Sub
You have to replace "A" and "B" with the number for the column, and you can simplify if you know how many rows you have. I was able to get it to work with the code below.
Sub LastFileDateTime()
For i = 2 To 45
Cells(i, 2).Value = FileDateTime(Cells(i, 1))
'FileDateTime("D:\QueryTable.xlsm")
Next
End Sub
Please be aware that I am working with a series of ~1000 line medical information databases. Due to the size of the databases, manual manipulation of the data is too time consuming. As such, I have attempted to learn VBA and code an Excel 2010 macro using VBA to help me accomplish parsing certain data. The desired output is to split certain characters from a provided string on each line of the database as follows:
99204 - OFFICE/OUTPATIENT VISIT, NEW
will need to be split into
Active Row Active Column = 99204 ActiveRow Active Column+3 = OFFICE/OUTPATIENT VISIT, NEW
I have researched this topic using Walkenbach's "Excel 2013: Power Programming with VBA" and a fair amount of web resources, including this awesome site, but have been unable to develop a fully-workable solution using VBA in Excel. The code for my current macro is:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
Cells(1, a + 3).Value = Trim(name(a))
Next a
End Sub
The code uses the "-" character as a delimiter to split the input string into two substrings (I have limited the output strings to 2, as there exists in some input strings multiple "-" characters). I have trimmed the second string output to remove leading spaces.
The trouble that I am having is that the output is being presented at the top of the activesheet, instead of on the activerow.
Thank you in advance for any help. I have been working on this for 2 days and although I have made some progress, I feel that I have reached an impasse. I think that the issue is somewhere in the
Cells(1, a + 3).Value = Trim(name(a))
code, specifically with "Cells()".
Thank you Conrad Frix!
Yah.. funny enough. Just after I post I have a brainstorm.. and modify the code to read:
Sub EasySplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, "-", 2)
For a = 0 To 1
ActiveCell.Offset(0, 3 + a).Value = Trim(name(a))
Next a
End Sub
Not quite the colkumn1,column4 output that I want (it outputs to column3,column4), but it will work for my purpose.
Now I need to incorporate a loop so that the code runs on each successive cell in the column (downwards, step 1) skipping all bolded cells, until it hits an empty cell.
Modified answer to modified request.
This will start on row 1 and continue until a blank cell is found in column A. If you would like to start on a different row, perhaps row 2 if you have headers, change the
i = 1
line to
i = 2
I added a check on the upper bound of our variant before doing the output writes, in case the macro is run again on already formatted cells. (Does nothing instead of erroring out)
Sub EasySplit()
Dim initialText As String
Dim i As Double
Dim name As Variant
i = 1
Do While Trim(Cells(i, 1)) <> ""
If Not Cells(i, 1).Font.Bold Then
initialText = Cells(i, 1).text
name = Split(initialText, "-", 2)
If Not UBound(name) < 1 Then
Cells(i, 1) = Trim(name(0))
Cells(i, 4) = Trim(name(1))
End If
End If
i = i + 1
Loop
End Sub
just add a variable to keep track of the active row and then use that in place of the constant 1.
e.g.
Dim iRow as Integer = ActiveCell.Row
For a = 0 To 1
Cells(iRow , a + 3).Value = Trim(name(a))
Next a
Alternate method utilizing TextToColumns. This code also avoids using a loop, making it more efficient and much faster. Comments have been added to assist with understanding the code.
EDIT: I have expanded the code to make it more versatile by using a temp worksheet. You can then output the two columns to wherever you'd like. As stated in your original question, the output is now to columns 1 and 4.
Sub tgr()
Const DataCol As String = "A" 'Change to the correct column letter
Const HeaderRow As Long = 1 'Change to be the correct header row
Dim rngOriginal As Range 'Use this variable to capture your original data
'Capture the original data, starting in Data column and the header row + 1
Set rngOriginal = Range(DataCol & HeaderRow + 1, Cells(Rows.Count, DataCol).End(xlUp))
If rngOriginal.Row < HeaderRow + 1 Then Exit Sub 'No data
'We will be using a temp worksheet, and to avoid a prompt when we delete the temp worksheet we turn off alerts
'We also turn off screenupdating to prevent "screen flickering"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Move the original data to a temp worksheet to perform the split
'To avoid having leading/trailing spaces, replace all instances of " - " with simply "-"
'Lastly, move the split data to desired locations and remove the temp worksheet
With Sheets.Add.Range("A1").Resize(rngOriginal.Rows.Count)
.Value = rngOriginal.Value
.Replace " - ", "-"
.TextToColumns .Cells, xlDelimited, Other:=True, OtherChar:="-"
rngOriginal.Value = .Value
rngOriginal.Offset(, 3).Value = .Offset(, 1).Value
.Worksheet.Delete
End With
'Now that all operations have completed, turn alerts and screenupdating back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
You can do this in a single shot without looping using the VBA equivalent of entering this formula, then taking values only
as a formula
=IF(NOT(ISERROR(FIND("-",A1))),RIGHT(A1,LEN(A1)-FIND("-",A1)-1 ),A1)
code
Sub Quicker()
Dim rng1 As Range
Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
With rng1.Offset(0, 3)
.FormulaR1C1 = "=IF(NOT(ISERROR(FIND(""-"",RC[-3]))),RIGHT(RC[-3],LEN(RC[-3])-FIND(""-"",RC[-3])-1 ),RC[-3])"
.Value = .Value
End With
End Sub