I am trying to add the value of a cell in an array, but i am getting a type mismatch error in my code. Why is this happening?
Dim rng As Range
Dim cell As Range
Dim arr As Variant
Set rng = Range("panel_is_on")
For Each cell In rng
If cell.Value2 = "On" Then
If cell.Offset(0, -1).Value2 = "ISJ" Or cell.Offset(0, -1).Value2 = "BSJ" Then
arr(i) = cell.Offset(0, -3).Value2
i = i + 1
End If
End If
Next cell
This works for me:
For Each cell In rng
If cell.Value2 = "On" Then
If cell.Offset(0, -1).Value2 = "ISJ" Or cell.Offset(0, -1).Value2 = "BSJ" Then
i = i + 1
ReDim Preserve arr(1 To i)
arr(i) = cell.Offset(0, -3).Value2
End if
Next cell
Related
I have error 438 message but cannot figure out why ? Do you have an idea ?
For each cells in my range B5:B28, I want to check string value and print a number accordingly to that string to the cell next to the right.
Public Sub RolloutStage()
Dim rng As Range
For Each rng In Worksheets("backEnd_Lost&Found").Range("B5:B28")
If Worksheets("backEnd_Lost&Found").rng.Value = "Live" Then
Worksheets("backEnd_Lost&Found").ActiveCell.Offset(0, 1).Value = 8
ElseIf Worksheets("backEnd_Lost&Found").rng.Value = "Configuration" Then
Worksheets("backEnd_Lost&Found").ActiveCell.Offset(0, 1).Value = 7
ElseIf Worksheets("backEnd_Lost&Found").rng.Value = "Testing" Then
Worksheets("backEnd_Lost&Found").ActiveCell.Offset(0, 1).Value = 6
ElseIf Worksheets("backEnd_Lost&Found").rng.Value = "Planned" Then
Worksheets("backEnd_Lost&Found").ActiveCell.Offset(0, 1).Value = 5
ElseIf Worksheets("backEnd_Lost&Found").rng.Value = "Pending" Then
Worksheets("backEnd_Lost&Found").ActiveCell.Offset(0, 1).Value = 4
ElseIf Worksheets("backEnd_Lost&Found").rng.Value = "Not planned" Then
Worksheets("backEnd_Lost&Found").ActiveCell.Offset(0, 1).Value = 3
ElseIf Worksheets("backEnd_Lost&Found").rng.Value = "No contact" Then
Worksheets("backEnd_Lost&Found").ActiveCell.Offset(0, 1).Value = 2
Else
Worksheets("backEnd_Lost&Found").rng.Value = "Not interested"
Worksheets("backEnd_Lost&Found").ActiveCell.Offset(0, 1).Value = 1
End If
Next
End Sub
Here is the correct version. Thank you
Public Sub RolloutStage()
Dim rng As Range
For Each rng In Worksheets("backEnd_Lost&Found").Range("B5:B28")
If rng.Value = "Live" Then
rng.Offset(0, 1).Value = 8
ElseIf rng.Value = "Configuration" Then
rng.Offset(0, 1).Value = 7
ElseIf rng.Value = "Testing" Then
rng.Offset(0, 1).Value = 6
ElseIf rng.Value = "Planned" Then
rng.Offset(0, 1).Value = 5
ElseIf rng.Value = "Pending" Then
rng.Offset(0, 1).Value = 4
ElseIf rng.Value = "Not planned" Then
rng.Offset(0, 1).Value = 3
ElseIf rng.Value = "No contact" Then
rng.Offset(0, 1).Value = 2
Else
rng.Value = "Not interested"
rng.Offset(0, 1).Value = 1
End If
Next
End Sub
Conditionally Populate Adjacent Cells
In your code...
You cannot use a variable as an object's property: instead of ws.rng.Value, use rng.Value.
A worksheet has no ActiveCell property: instead of ws.ActiveCell, use rng.
The For Each...Next Loop
What does the For Each cell In rg.Cells line do? You could think of it that in the first iteration, it writes the following invisible line right below:
Set cell = rg.Cells(1) ' B5
So in the continuation, you will use this cell to check the value and again use
this cell to write another value to the cell adjacent to the right.
In the next iteration, the invisible line looks like this:
Set cell = rg.Cells(2) ' B6
etc.
An Improvement
Public Sub RolloutStage()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Sheets("backEnd_Lost&Found")
Dim srg As Range: Set srg = ws.Range("B5:B28")
Dim sCell As Range, dCell As Range
For Each sCell In srg.Cells
Set dCell = sCell.Offset(, 1)
Select Case CStr(sCell.Value)
Case "Live": dCell.Value = 8
Case "Configuration": dCell.Value = 7
Case "Testing": dCell.Value = 6
Case "Planned": dCell.Value = 5
Case "Pending": dCell.Value = 4
Case "Not planned": dCell.Value = 3
Case "No contact": dCell.Value = 2
Case Else: sCell.Value = "Not interested": dCell.Value = 1
End Select
Next sCell
End Sub
I have a large table of data with multiple columns that contain data for mostly triplicates of results. each row contains results from one data point for each subject. most of the subjects have three replicate results, but in some cases, there is only one or two. the sheet is sorted on the subject id column (which is my named range assigned to the variable rng used in the for loop).
this loop tests whether "targetcell" in the range "rng" (which is set to the named range in the sheet that contains the subject id), find the bottom row of any subjects duplicate or triplicate values, and then generates the mean in the newly inserted column:
Set rng = Range("clonesptid")
col = ActiveCell.Column
ActiveCell.Offset(0, 1).EntireColumn.Insert
anchor = col - rng.Column
'MsgBox "cell to test is " & rng(1)
'debugging message box to check where the ptid range is
'MsgBox "Range for ptID is " & rng.Column & " and the active cell address is " & ActiveCell.Address & " and the activecell col is " & anchor
For Each cell In rng
'uncomment the line below to check the cell addresses
' str = str & Cell.Address & " contains " & Cell.Value & "(above=" & Cell.Offset(-1, 0).Value & " below=" & Cell.Offset(1, 0).Value & vbNewLine
' MsgBox "What is our test value?" & vbNewLine & cell.Value
If IsEmpty(cell.Value) = True Then Exit For
targetcell = cell.Value
If cell.Row > 2 Then twoup = cell.Offset(-2, 0).Value
If cell.Row > 1 Then oneup = cell.Offset(-1, 0).Value
onedown = cell.Offset(1, 0).Value
If IsEmpty(targetcell) = False Then
If cell.Row = 1 Then
'adds title with means to first header row
Cells(1, col + 1).Value = Cells(1, col).Value & " mean"
ElseIf cell.Row = 2 And targetcell <> oneup And targetcell <> onedown Then
'test the first value, if unique mean = the value of the cell
cell.Offset(0, anchor + 1).Value = cell.Offset(0, anchor).Value
ElseIf targetcell <> oneup And targetcell <> onedown Then
'for all the rest of the cells in the range, this condition tests for singlets
cell.Offset(0, anchor + 1).Value = cell.Offset(0, anchor).Value
ElseIf targetcell = oneup And targetcell <> twoup And targetcell <> onedown Then
'test for two values
cell.Offset(0, anchor + 1).Value = (cell.Offset(0, anchor).Value + cell.Offset(-1, anchor).Value) / 2
ElseIf targetcell = oneup And targetcell = twoup And targetcell <> onedown Then
'test for three values
cell.Offset(0, anchor + 1).Value = (cell.Offset(0, anchor).Value + cell.Offset(-1, anchor).Value + cell.Offset(-2, anchor).Value) / 3
Else
'this is the first or second replicate of duplicates or triplicates, but not yet the bottom value
cell.Offset(0, anchor + 1).Value = ""
End If
End If
Next
If you have a specific operation like "find all same values up and down" then it's best to move that to a separate method.
Untested:
Sub tester()
Dim rng As Range, cell As Range, dups As Range
Dim lastDup As Range, col As Long, anchor As Long
col = ActiveCell.Column
Cells(1, col + 1).EntireColumn.Insert
Cells(1, col + 1).Value = "Mean"
Set rng = Range("clonesptid")
anchor = col - rng.Column
Set cell = rng.Cells(1)
Do While Len(cell.Value) > 0
Set dups = DupsRange(cell) 'get contiguous range with same value in column
Set lastDup = dups.Cells(dups.Cells.Count)
'calculate your average here
lastDup.Offset(0, anchor + 1) = Application.Average(dups.Offset(0, anchor))
Set cell = lastDup.Offset(1, 0) 'next set
Loop
End Sub
'Given a cell, check up and down to find
' the contiguous same-value range
Public Function DupsRange(c As Range) As Range
Dim cStart As Range, cEnd As Range
If Len(c.Value) = 0 Then Exit Function
Set cStart = c
Set cEnd = c
Do While cStart.Row > 1
If cStart.Offset(-1, 0).Value = c.Value Then _
Set cStart = cStart.Offset(-1, 0) Else Exit Do
Loop
Do While cEnd.Row < Rows.Count
If cEnd.Offset(1, 0).Value = c.Value Then _
Set cEnd = cEnd.Offset(1, 0) Else Exit Do
Loop
Set DupsRange = c.Parent.Range(cStart, cEnd)
End Function
I have a comboBox which list two columns (A and H). The conditions to list the items are:
1. Add items who doesn't content blank row from the column A
2. Add items who aren't equal to zero for the column H
I was able to perform the first condition with this code:
Private Sub UserForm_Activate()
Dim currentCell As Range
With ComboBox1
.ColumnCount = 2
.ColumnWidths = "70;30"
.ColumnHeads = False
.BoundColumn = 1
With Worksheets("Sheet")
With .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
For Each currentCell In .Cells
If Len(currentCell) > 0 Then
With Me.ComboBox1
.AddItem currentCell.Value
.List(.ListCount - 1, 1) = currentCell.Offset(, 7).Value
End With
End If
Next currentCell
End With
End With
End With
End Sub
I tried to change that part for the second condition, it doesn't work:
With Worksheets("Sheet")
With .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
For Each currentCell In .Cells
If Len(currentCell) > 0 & currentCell.Offset(, 7).Value <> 0 Then
With Me.ComboBox1
.AddItem currentCell.Value
.List(.ListCount - 1, 1) = currentCell.Offset(, 7).Value
Thank you
In your second condition, all you need to do is to replace the "&" with "And" to make it work. I would also avoid too many nested With's here. Maybe something like this:
Dim myRange As Range
Dim mySheet As Worksheet
Dim currentCell As Range
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Sheet3")
Set myRange = Range(.Cells(2, 1), .Cells(lastRow, 1))
End With
With ComboBox1
.ColumnCount = 2
.ColumnWidths = "70;30"
.ColumnHeads = False
.BoundColumn = 1
For Each currentCell In myRange
If Len(currentCell) > 0 And currentCell.Offset(, 7).Value <> 0 Then
With Me.ComboBox1
.AddItem currentCell.Value
.List(.ListCount - 1, 1) = currentCell.Offset(, 7).Value
End With
End If
Next currentCell
End With
Private Sub UserForm_Initialize()
Dim Sh As Worksheet, rng As Range, arr(), cL As Range
Set Sh = ThisWorkbook.Worksheets("Sheet1")
'Make union of cells in Column A based on the two conditions given
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Sh.Range("A" & i).Value <> "" And Sh.Range("H" & i).Value <> 0 Then
If rng Is Nothing Then
Set rng = Sh.Range("A" & i)
Else
Set rng = Union(rng, Sh.Range("A" & i))
End If
End If
Next
'Make array of values of rng ang corresponding H Column cells
ReDim arr(rng.Cells.Count - 1, 1)
i = 0
For Each cL In rng
arr(i, 0) = cL.Value
arr(i, 1) = cL.Offset(0, 7).Value
Debug.Print rng.Cells(i + 1).Address; arr(i, 0); arr(i, 1)
i = i + 1
Next
'Assign the array to the ComboBox
ComboBox1.ColumnCount = 2
ComboBox1.List = arr
End Sub
I tried to make macro for my daily job, but i cannot use IF as formula due to so many item in my excel file, so solution is to convert formula to VBA code.
I need help to convert if formula to VBA code in excel as below:
=IF(J2<>J1,AD2-X2,AE1-X2).
Here is an answer to your question. However, it is limited to only work with OP information. Also, if the calculations are taking too long then, you should try setting your calculation to Manual (Formulas->Calculation Options->Manual).
Option Explicit
Public Sub RunIF()
Dim vntOut As Variant
Dim rngSame As Range
With ActiveSheet
Set rngSave = .Range("X2")
If (LCase(Trim(.Range("J2").Value)) <> LCase(Trim(.Range("J1").Value))) Then
vntOut = .Range("AD2").Value - rngSave.Value
Else
vntOut = .Range("AE1").Value - rngSave.Value
End If
.Range("AE2").value = vntOut
Set rngSave = Nothing
End With
End Sub
And here is your code converted to use Column J:
Private Sub CommandButton12_Click()
Dim x As Long
Dim LastRow As Long
Dim i as long
With Sheets("Shipping Schedule")
LastRow = .Cells(.Rows.Count, "J").End(xlUp).Row
For i = 2 to LastRow
set r = .Range("J" & I)
'For Each r In .Range("J2:J" & LastRow)
If LCase(Trim(r.Value)) <> LCase(Trim(r.Offset(-1, 0).Value)) Then
'ae2 = "AD2" - "x2"
r.Offset(0, 21).Value = r.Offset(0, 20).Value - r.Offset(0, 14).Value
Else
'ae2 = "AE1" - "x2"
r.Offset(0, 21).Value = r.Offset(-1, 21).Value - r.Offset(0, 14).Value
End If
set r = nothing
Next i
End With
End Sub
However, you should increment with I instead of for each as the cells are dependent on the previous row and excel may not loop through the range like you would prefer.
Excel Formula to VBA: Fill Column
Sub FillColumn()
Const cCol As Variant = "J" ' Last-Row-Column Letter/Number
Const cCol1 As Variant = "AD"
Const cCol2 As Variant = "X"
Const cCol3 As Variant = "AE"
Const cFirstR As Long = 1 ' First Row
Dim rng As Range ' Last Used Cell in Last-Row-Column
Dim i As Long ' Row Counter
Set rng = Columns(cCol).Find("*", , xlFormulas, , xlByColumns, xlPrevious)
If rng Is Nothing Then Exit Sub
For i = cFirstR To rng.Row - 1
If Cells(i + 1, cCol) <> Cells(i, cCol) Then
Cells(i + 1, cCol3) = Cells(i + 1, cCol1) - Cells(i + 1, cCol2)
Else
Cells(i + 1, cCol3) = Cells(i, cCol3) - Cells(i + 1, cCol2)
End If
Next
End Sub
Private Sub CommandButton12_Click()
Dim x As Long
Dim LastRow As Long
Sheets("Shipping Schedule").Select
With Sheets("Shipping Schedule")
LastRow = .Cells(.Rows.Count, "N").End(xlUp).Row
For Each r In .Range("N2:N" & LastRow)
If r.Value <> "" Then
r.Offset(0, 19).Value = ………………………………….
End if
Next r
End With
End Sub
What I am trying to do is get my macro to search the data in Column "E". If the cell value contains "string", then I would like to offset by one column to the left, verify if, in the new selected cell, cell value contains "". If the new selected cell value is "" then background color is 19, if it contains "*" then background color is -4142.
Here is the code I have so far:
Sub Set_Background_Color ()
lRow = Range("E" & Rows.Count).End(xlUp).Row
Set MR = Range("E2:E" & lRow)
For Each cell In MR
If cell.Value = "X" Then cell.Offset(, -1).Interior.ColorIndex = 19
Next
End Sub
I can't seem to figure out how to embed a new If statement after the Offset and before the .Interior.ColorIndex
I have tried this mess but you will see immediately that it does not work.
If cell.Value = "X" Then
ElseIf cell.Offset(, -1).Value = "" Then cell.Interior.ColorIndex = 19
Else: cell.Interior.ColorIndex = -4142
Any help is greatly apreciated!
So close!
Sub Set_Background_Color ()
Dim lRow As Long
Dim MR As Range
Dim cel As Range
lRow = Range("E" & Rows.Count).End(xlUp).Row
Set MR = Range("E2:E" & lRow)
For Each cel In MR
If cel.Value = "string" Then
If cel.Offset(, -1).Value = "" Then
cel.Offset(, -1).Interior.ColorIndex = 19
ElseIf cel.Offset(, -1).Value = "*" Then
cel.Offset(, -1).Interior.ColorIndex = -4142
End If
End If
Next
End Sub
If by contains "*" you mean "has any content" then:
If cell.Value = "X" Then
cell.Interior.ColorIndex = IIf(Len(cell.Offset(0, -1).Value) = 0, 19, xlNone)
End If