Trouble nesting if.. then in a loop in Excel 2010 - excel

I apologize if this is an easy question, I just started macro programming yesterday and have not written in BASIC since qBasic (or any language for a while). I'm tring to read if a variable is equal to a specific value and, if so, write a different cell into a spreadsheet if it contains data. I keep getting an error of next without a for. It runs fine without the first if statement, can someone help me out? Bonus if you can help on writing the value rather than content, but I can figure that out without bothering you fine folks. Thanks for the help getting me to this point, this site has been invaluable. You'll probably recognize some of the coding.
Sub B920LOI()
x = 5
iMaxRow = 3000
For iRow = 3 To iMaxRow
If Sheets("Sheet2").Cells(iRow, "B") = "B920" Or Sheets("Sheet2").Cells(iRow, "B") = " B920" Then
If Sheets("Sheet2").Cells(iRow, "K") > 35 And Sheets("Sheet2").Cells(iRow, "K") < 55 Then
' Check that cell is not empty.
' Copy the cell to the destination
With Worksheets("Sheet2").Cells(iRow, "K")
.Copy Destination:=Worksheets("920 LOI").Cells(x, "B")
End With
x = x + 1
Else
'Nothing in this cell.
'Do nothing.
End If
Else
'Nothing in this cell.
'Do nothing.
End If
Next iRow
End Sub
This is the "working version" Thank you.

Your nests have to match... the "End With" needs to be inside the If block where the With is.

Related

Excel function doesn't write anything

Goodmorning, i wanted to do a macro in Excel that multiply the element on the right for every element on the left (then put the result in another column), till a blank cell.
This is an example of the elements:
[enter image description here][1]
And this is what i try to write with no result...it seems like the cycle goes well, but it doesn't write anything ... could you please help me out? Anyway, sorry for my bad English, i hope i made it clear.
Thank you.
Sub test()
Range(A1).Select
x = 1
y = 1
Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))
If IsEmpty(Ax) = True Then
y = x + 1
End If
If IsEmpty(Ax) = False Then
Cells(E, x).Value = Cells(A, x).Value * Cells(D, y).Value
End If
x = x + 1
ActiveCell.Offset(1, 0).Select
Loop
End Sub
you have to put the cell references as strings.
VBA will interpret Range(A1) as whatever variable A1 is set to. It is NOT the "A1" cell in your spreadsheet.
Correct is
Range("A1").Select
Similarly if you have a variable x, and want to get the cell reference A1 then you need to do something like this:
x=1
if IsEmpty("A" & x) then ...
Also, the Cells(row,column) function uses row first, then column.
I'm assuming you have "On Error Resume Next" somewhere in your code, as what you have written should throw up a lot of errors.

If then statement to delete columns

New to VBA and trying to understand how to write an efficient code for data cleaning purposes.
I have a spreadsheet where my first step would be to remove entire columns with certain headers (about 25). I tried writing If Then statements for each header, but I find it only works on the first item, then I get error 424 (object undefined). I don't completely understand the VBA structure yet, so not sure how I can write this more efficiently
Sub DataCleaning()
Set MR = Range("A1:ZA1")
For Each Cell In MR
If Cell.Value = "subject" Then Cell.EntireColumn.Delete
If Cell.Value = "Study" Then Cell.EntireColumn.Delete
If Cell.Value = "site" Then Cell.EntireColumn.Delete
End Sub
This code will eventually have a series of additional steps as well, like relabeling headers and will be applied to more than 1 tab, so each header won't necessarily be found all the time.
Any help in structuring this better would be appreciated!!
Give this a try:
Sub DataCleaning()
For i = 677 To 1 Step -1
With Cells(1, i)
v = .Value
If v = "subject" Or v = "Study" Or v = "site" Then
.EntireColumn.Delete
End If
End With
Next i
End Sub

Turn a function into a subprocess -- STUCK

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.

SIMPLE Delete line from cell?

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

Excel Comparision to find the range of number

Hello Please consider my silly question, I am stuck here since a long time
ElseIf Cells(m1, a) >= 1 And Cells(m1, a) <= 98 Then
Cells(m1, a).Font.Bold = True
here only the values without decimal point (eg. 4,56,90)etc are getting bold, values with decimal point (4.5,56.5,90.54) despite being in the rqnge are not getting filtered.
Please suggest possible problem
I think the problem is with French numbering system as the data coming is from France.
Thank you
Is there any way to consider different numbering system, with the US system....???
You should use Cells(m1,a).value as well as Cells(m1,a).value
The code below will examine the list of cell are selected before the macro is run. For each cell, if it's value is [1..98] then I take the state and toggle it.
Sub toggleBoldInSelection()
Dim cellValue
For Each curCell In Selection
cellValue = curCell.Value
If (cellValue >= 1) And (cellValue <= 98) Then
curCell.Font.Bold = Not curCell.Font.Bold 'True
End If
Next curCell
End Sub
Try this
ElseIf Val(Cells(m1, a).Value) >= 1 And Val(Cells(m1, a).Value) <= 98 Then
If you are not running this code from the sheet code area then do not forget to fully qualify the cells object. For example
ThisWorkbook.Sheets("Sheet1").Cells(m1, a).Value

Resources