I have a small range of cells, C6:C10. I'm trying to apply an if statement to this range of cells using VBA code. Currently, my code takes the output of the if statement for the first cell (C6), and replicates that value for cells C7:C10. The if statement is correct, I'm just not sure how to apply it to a range of cells in a column.
Sub Cleanup()
Dim Segment As String
Dim i As Integer
Segment = ActiveCell(6, 3).Value
For i = 6 To 10
If Right(Left(Segment, 6), 1) = "/" Then
ActiveCell(i, 3).Value = Left(Segment, 5)
Else
ActiveCell(i, 3).Value = Left(Segment, 6)
End If
Next i
End Sub
It should be fine if you use Cells instead of ActiveCell, except that you'll have to change your loop to go from 7 to 10 or else it will over-write the original cell as well as C7:C10.
Sub Cleanup()
Dim Segment As String
Dim i As Integer
Segment = Cells(6, 3).Value
For i = 7 To 10
If Right(Left(Segment, 6), 1) = "/" Then
Cells(i, 3).Value = Left(Segment, 5)
Else
Cells(i, 3).Value = Left(Segment, 6)
End If
Next i
End Sub
Sub Cleanup()
Dim Segment As String
Dim i As Integer
Segment = Cells(i, 3).Value
For i = 7 To 10
If Right(Left(Segment, 6), 1) = "/" Then
cells(i, 3).Value = Left(Segment, 5)
Else
Cells(i, 3).Value = Left(Segment, 6)
End If
Next i
End Sub
here three (out of many other) possible codes, in simplicity order (the last being more simple than the first):
Option Explicit
Sub Cleanup()
Dim Segment As String
Dim i As Integer
For i = 6 To 10
Segment = Cells(i, 3).Value '<== Cells(i, 3) is the current cell as per the current row (i)
If Mid(Segment, 6, 1) = "/" Then
Cells(i, 3).Value = Left(Segment, 5)
Else
Cells(i, 3).Value = Left(Segment, 6)
End If
Next i
End Sub
Sub Cleanup2()
Dim i As Integer
For i = 6 To 10
With Cells(i, 3) 'avoid repetitions (and a variable, too) by using 'With' keyword and implying 'Cells(i, 3)' preceeds every dot (".") till next 'End With" statement
If Right(Left(.Value, 6), 1) = "/" Then
.Value = Left(.Value, 5)
Else
.Value = Left(.Value, 6)
End If
End With
Next i
End Sub
Sub Cleanup3()
Dim i As Integer
For i = 6 To 10
With Cells(i, 3)
.Value = Left(.Value, IIf(Mid(.Value, 6, 1) = "/", 5, 6)) ' use Iif function to avoid multiple lines. Also use 'Mid' function in lieu of 'Right(Left(..))'
End With
Next i
End Sub
Related
The below VBA code sets a range of cells as commentArray, removes any blanks from the array and creates a new, blank free array, called commentResults. I then want to declare the array.
There is a possibility, depending on my source data, that the array could then still be empty so the below doesn't work to declare
thisws.Cells(i, 19).Resize(columnsize:=UBound(commentResults) - LBound(commentResults) + 1).Value = commentResults
So I thought I would add a check (the if statement after the debug.print), that only declared the array if array(0) wasn't empty but I continuously get an error 9 which I can't resolve.
Dim commentArray(4) As Variant
commentArray(0) = Cells(24, 4).Value
commentArray(1) = Cells(25, 3).Value
commentArray(2) = Cells(26, 3).Value
commentArray(3) = Cells(27, 3).Value
'a and b as array loops
Dim a As Long, b As Long
Dim commentResults() As Variant
'loops through the array to remove blanks - rewrites array without blanks into commentArray
For a = LBound(commentArray) To UBound(commentArray)
If commentArray(a) <> vbNullString Then
ReDim Preserve commentResults(b)
commentResults(b) = commentArray(a)
b = b + 1
End If
Next a
Debug.Print b
If IsError(Application.Match("*", (commentResults), 0)) Then
Else
thisws.Cells(i, 19).Resize(columnsize:=UBound(commentResults) - LBound(commentResults) + 1).Value = commentResults
b = 0
End If
Any thoughts on why this might not work?
I have also tried:
If commentResults(0) <> vbNullString Then
thisws.Cells(i, 27).Resize(columnsize:=UBound(commentResults) - LBound(commentResults) + 1).Value = commentResults
End If
Sub CommentArray()
Dim Comments As Range, c As Range
Set Comments = Union(Cells(24, 4), Range(Cells(25, 3), Cells(27, 3)))
Dim commentResults() As Variant
Dim i As Long
i = 0
For Each cell In Comments
If cell.Value <> "" Then
ReDim Preserve commentResults(i)
commentResults(i) = cell.Value
i = i + 1
End If
Next cell
Dim debugStr As String
For i = LBound(commentResults) To UBound(commentResults)
debugStr = debugStr & commentResults(i) & Chr(10)
Next i
MsgBox debugStr
End Sub
I'm trying to make a loop that will go thru this data set.
This is how the output should look.
Im still getting the hang of loops, but this is what i have so far:
Private Sub CommandButton1_Click()
Dim i As Long, j As Long, k As Byte, iLines As Long
j = 1
For i = 1 To 25
For k = 1 To 8
If k = 1 Then
Cells(j, 10).Value = Len(Cells((j + 2), 1).Value) - Len(Replace(Cells((j + 2), 1).Value, ",", "")) + 1
Cells(i, 11).Value = "SET"
Cells(i, 12).Value = Cells(i, 1).Value
End If
Next k
Next i
End Sub
My problem is on my loop output at the moment. It only counts the commas in the first data set and not the other ones. Also where it outputs SET it copies down instead of just putting it in one cell. See Below.
I will probably have more question as i progress along. Thanks in advance for the help!
Try this:
Whenever possible get rid of the loop. I replaced it with a find to find the next cell with "HW" in it. It will automatically step from one "HW" to the Next.
When using steps anchor everything on the one row and expand selection using resize.
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim i As Long
Dim k As Long
Set ws = ActiveSheet
With ws
For i = 1 To 200
If Left(.Cells(i, 1).Value, 2) = "HW" Then
On Error Resume Next
k = .Range(.Cells(i + 1, 1), .Cells(200, 1)).Find("HW").Row
On Error GoTo 0
If k <= i Then k = 200
.Cells(i, 10).Value = Len(Cells((i + 2), 1).Value) - Len(Replace(Cells((i + 2), 1).Value, ",", "")) + 1
.Cells(i, 11).Value = "SET"
.Cells(i, 12).Resize(k - i).Value = .Cells(i, 1).Resize(k - i).Value
i = k - 1
End If
Next i
End With
End Sub
I want to refer a column by its header name.
Currently column is 4th one and header name is "Preference".
And the column consists of "Yes" or "No"
5th column header is "Reason"
And it is filled only when "Preference" column is "No"
My code is
Private Sub CommandButton1_Click()
Dim i As Integer
Dim MyWorksheetLastRow As Byte
Dim MyWorksheetLastColumn As Byte
MyWorksheetLastRow = Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
MyWorksheetLastColumn = Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
Worksheets(1).Cells(1, MyWorksheetLastColumn + 1).Value = "Result"
For i = 2 To MyWorksheetLastRow
If Cells(i, 4).Value = "Yes" Then
Cells(i, MyWorksheetLastColumn + 1).Value = Cells(i, 4).Value
Else: Cells(i, MyWorksheetLastColumn + 1).Value = Cells(i, 5).Value
End If
Next i
End Sub
What I want is instead of Cells(i,4) , I want to call the it by column header example: Cells(i,"Preference").
Because I won't the column number of "Preference" in prior. And I use excel vba because I have to deal 20-30 similar files.
Further to my comments, if you want to do it direct, you would have to do this:
cells(i,Application.WorksheetFunction.Match("Preference", Range("1:1"), 0)).
Here is a function to find the column for X instance. I have put a subroutine in there to call it as an example for you.
Sub ColInstanceExample()
Dim MyColInstance As Long
MyColInstance = ColInstance("Preference", 2) 'Pass in what you are searching for and the instance you want to return the column number for
If MyColInstance = 0 Then
MsgBox "Not Found"
Else
MsgBox "Found at column: " & MyColInstance
End If
End Sub
Function ColInstance(HeadingString As String, InstanceNum As Long)
Dim ColNum As Long
On Error Resume Next
ColNum = 0
For X = 1 To InstanceNum
ColNum = (Range("A1").Offset(0, ColNum).column) + Application.WorksheetFunction.Match(HeadingString, Range("A1").Offset(0, ColNum + 1).Resize(1, Columns.Count - (ColNum + 1)), 0)
Next
ColInstance = ColNum
End Function
I've currently got the code below. There can only currently be seven values for "ins" and so the code suffices, however as of next month I have been told that there will be over 900 values!
I assume that rather than writing another 900 case statements I could use an array of some sort. Can anyone give me a nudge in the right direction?
Private Sub test()
Dim i As Long
Dim lr As Long
Dim ins As String
lr = Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To lr
Select Case Cells(i, 20)
Case Is = ""
ins = Mid(Cells(i, 11), 14, 2)
Select Case Cells(i, 10)
Case "Inx", "ComInx"
Select Case Cells(i, 9)
Case "EINX"
Select Case ins
Case "LD"
Cells(i, 9).Value = "SR"
Case "GP"
Cells(i, 9).Value = "GAMA"
Case "AV"
Cells(i, 9).Value = "NU"
Case "AX"
Cells(i, 9).Value = "AXC"
Case "MZ"
Cells(i, 9).Value = "MZE"
Case "AD"
Cells(i, 9).Value = "AGD"
Case "AG"
Cells(i, 9).Value = "AG"
End Select
End Select
End Select
End Select
Next
End Sub
I would use a dictionary object for this. Here is a proof-of-concept based on your lines:
Private Sub test()
Dim i As Long
Dim lr As Long
Dim ins As String
Dim rngCases As Range, rngCases2 As Range, rngCase As Range
Dim dicCases As Dictionary
lr = Range("A" & Rows.Count).End(xlUp).Row
' rngCases stores the possible values of ins
' Here I assume they are stored in col 40
Set rngCases = Range(Cells(6, 40), Cells(lr, 40))
' rngCases2 stores the values you want to map for each value of ins.
' Here I assume they are stored in col 41
' No of entries = No of entries of rngCases
Set rngCases2 = Range(Cells(6, 41), Cells(lr, 41))
Set dicCases = New Dictionary
For Each rngCase In rngCases
If Not dicCases.Exists(rngCase.Value) Then
dicCases.Add Key:=rngCase.Value, Item:=rngCases2.Value
End If
Next rngCase
For i = 6 To lr
Select Case Cells(i, 20)
Case Is = ""
ins = Mid(Cells(i, 11), 14, 2)
Select Case Cells(i, 10)
Case "Inx", "ComInx"
Select Case Cells(i, 9)
Case "EINX"
' We simply need to refer to the mapped value of ins
If dicCases.Exists(ins) then
Cells(i, 9) = dicCases.Item(ins)
Else
' Throw an error or do something here
End If
End Select
End Select
End Select
Next
End Sub
To enable the Dictionary, go to Tools->References and select Microsoft Scripting Runtime.
I hope this gets you started!
In my excel table i have one row (5th row) as number of items and another (6th row) as the price of the items. For example i want to multiply 200 with $56.50 but I am having a problem with this script. Can anyone please help.
Sub calcprice()
Dim i As Integer
Dim iRowNumber As Integer ' Integer to store result in
Dim val As Double
iRowNumber = InputBox(Prompt:="Number of Rows", _
Title:="Rows: ", Default:="# of Rows")
For i = 1 To iRowNumber
If Cells(i, 5).Value >= 0 And Cells(i, 6).Value >= 0 And IsEmpty(Cells(i, 5)) = False And IsEmpty(Cells(i, 5)) = False Then
val = FormatCurrency(Cells(i, 5).Value) * Cells(i, 6).Value
Cells(i, 7).Value = val
End If
Next i
End Sub
it says runtime error 13
type mismatch
here is the image:
Here is the link: https://www.dropbox.com/s/lla2cuz8hqu5qyp/test.xlsm
also i cannot use the =a*b i have to use macros!
You don't need a loop
You can work with a single shot range in colunm G that
Adds a formula from G5 to the user entered iRowNumber to test whether a result > 0 happens in each row (or adds "" for a 0 result)
overwrite the formulae with the values
Sub calcprice()
Dim iRowNumber As Long ' Integer to store result in
iRowNumber = InputBox(Prompt:="Number of Rows", _
Title:="Rows: ", Default:="# of Rows")
With Range(Cells(5, 7), Cells(iRowNumber, 7))
.FormulaR1C1 = "=IF(N(RC[-1]*RC[-2]),RC[-1]*RC[-2],"""")"
.Value = .Value
End With
End Sub
Try this out. Remember to format the 5th cell and the 6th cell to the currency you like!
Sub calcprice()
Dim iRowNumber As Integer
Dim val As Double
iRowNumber = InputBox(Prompt:="Number of Rows", _
Title:="Rows: ", Default:="# of Rows")
For i = 1 To iRowNumber
If Cells(i, 5).Value >= 0 And Cells(i, 6) >= 0 Then
If Cells(i, 6).Value > 0 Then
val = Cells(i, 5).Value * FormatCurrency(Cells(i, 6).Value)
Cells(i, 7).Value = val
End If
End If
Next i
End Sub
You have For i = 1 to iRowNumber
The image shows that the data starts in row 5. The previous rows contain text.
Therefore, try For i = 5 to iRowNumber