I have a code that counts the cell in a range if there's a number. The total number of cell counted will then be shown in row 3. My issue now is that the formula is not variable and I have no idea how to make it too.
If I enter this code, row 3 reports all the same result (which is from the first column of data). Hoping somebody can help me here!!
Sub Six_Continue()
Dim Rng As Range
Dim LastClm As Long
With ActiveSheet
LastClm = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set Rng = Range(.Cells(3, 3), .Cells(3, LastClm))
Rng.Value = Application.WorksheetFunction.CountIf(Range("C5", "C" & Cells(Rows.Count, 5).End(xlUp).Row), "<>?")
End With
End Sub
Your CountIf will count cells even if they don't contain a number. Using Count ensures that only cells containing numbers are taken into account.
Sub Six_Continue()
Dim Rng As Range
Dim LastClm As Long
Dim myClm As Long
With ActiveSheet
LastClm = .Cells(1, .Columns.Count).End(xlToLeft).Column
For myClm = 1 To LastClm
Set Rng = .Cells(3, myClm)
Rng.Value = Application.WorksheetFunction.Count(Range(.Cells(5, myClm), .Cells(.Cells(Rows.Count, myClm).End(xlUp).Row, myClm)))
Next myClm
End With
End Sub
Try this modified version:
Sub Six_Continue()
Dim Rng As Range
Dim LastClm As Long, i As Long
LastClm = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastClm
Cells(3, i).Value = Application.WorksheetFunction.CountIf(Range(Cells(1, i), Cells(2, i)), "<>?")
Next
End Sub
Related
I am having real difficulty finding anything that has my query. I can find the different pieces of what I need but cannot put it together.
What I need to do is look through a set range and if value is between 0.001 and 0.26 then
copy cell and paste in next empty cell in column ("DA"), also copy cell from the same row that the value was found but copy from column ("C") and paste in next to column ("DB").
I know I have to loop through with an If statement, and will have to offset cell when it finds match to criteria. but I cannot put it together.
I have tried the following pieces of code.
Sub COPYcell()
Dim Last As Long
Dim i As Long, unionRng As Range
Last = 61
Dim lastrow As Long
lastrow = Sheets("Sheet1").Range("DA100").End(xlUp).Row
For i = 5 To Last
If (.Cells(i, "J").Value) >= 0.01 And (.Cells(i, "J").Value) <= 0.26 Then
'Cells(i, "DA").Value = Cells(i, "J").Value
Range(i, "J").Copy = Range("DA" & lastrow)
Cells(i, "J").Offset(, -8) = Range("DB" & lastrow)
Range("DC" & lastrow) = "July"
End If
Next i
End Sub
Try the following:
Option Explicit
Public Sub COPYcell()
Dim last As Long, sht1 As Worksheet
Dim i As Long, unionRng As Range, lastrow As Long, nextRow
Application.ScreenUpdating = False
Set sht1 = Worksheets("Sheet1")
last = 61
With sht1
lastrow = .Cells(.Rows.Count, "DA").End(xlUp).Row
nextRow = IIf(lastrow = 1, 1, lastrow + 1)
For i = 5 To last
If .Cells(i, "J").Value >= 0.01 And .Cells(i, "J").Value <= 0.26 Then '1%=26%
If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, .Cells(i, "J"))
Else
Set unionRng = .Cells(i, "J")
End If
End If
Next i
If Not unionRng Is Nothing Then
unionRng.Copy .Range("DA" & nextRow)
unionRng.Offset(0, -7).Copy .Range("DB" & nextRow)
End If
End With
Application.ScreenUpdating = False
End Sub
Your current code was giving me errors about range objects. I kept it simple and assigned cell values to cell values. Also, I am not sure if you meant .01 or .001. You may fiddle with that. The issue I saw was that as you find more matches, you want lastrow to go up so you are writing in what is now the last row, not what once was. You also had some unused variables pasted in, so I simplified. Here is the result.
Sub COPYCell()
Dim Last As Long
Dim i As Long
Last = 61
Dim lastrow As Long
lastrow = Sheets("Sheet1").Range("DA100").End(xlUp).Row + 1
For i = 5 To Last
If (Cells(i, "J").Value <= 0.26) And (Cells(i, "J").Value >= 0.001) Then
Cells(lastrow, "DA").Value = Cells(i, "J").Value
Cells(lastrow, "DB").Value = Cells(i, "C").Value
Cells(lastrow, "DC").Value = "July"
lastrow = lastrow + 1
End If
Next i
End Sub
EDIT Added +1 on lastRow per comment. I had tested where I had none yet.
You need to loop your range and inside loop check if you cell is not empty copy the cell value and in else paste in next empty cell.
Sample code:
Sub Func ()
Dim rng As Range, cell As Range
Set rng = Range("A1:A3")
For Each cell In rng
If (IsEmpty(cell.value))
Cell.paste()
Else
cell.copy()
End if
Next cell
End sub
The code is not tested because I typed it on a phone.
i have an excel file in which i have data month wise, so i want to select Column F, G and H from the active cell till the last data of that column and then special paste it.
I am using this Code for selecting that range but not able to do that. it is selecting the data from the F1.
Sub selecting_range()
Dim rng As Range
Dim LastRow As Long
currentcell = ActiveCell
LastRow = Cells(Rows.Count, "F" & currentcell).End(xlUp).Row
Set rng = Range("F1:H" & LastRow)
rng.Select
End Sub
Considering the fact that the "F" and "H" are hardcoded, then you can build up something like this:
Sub SelectingRange()
Dim rng As Range
Dim lastRow As Long
lastRow = Cells(Rows.Count, "F").End(xlUp).Row
Set rng = Range(Cells(ActiveCell.Row, "F"), Cells(lastRow, "H"))
rng.Select
End Sub
Or you can write it in 1-line, just to confuse someone:
Sub SelectingRange()
Range(Cells(ActiveCell.Row, "F"), Cells(Cells(Rows.Count, "F").End(xlUp).Row, "H")).Select
End Sub
Looking to fill a variable range here. I can fill my formula to the right but when I want to fil it down, the formula disappears. I have also attached a picture and Column A starts with "Fund Name". Hope somebody can help me here thank you!! The link to the table is here. 1: https://i.stack.imgur.com/y1ZVH.png
Sub Six_Continue()
Dim Lastrow As Long
Dim lrow As Range
Dim Lastcol As Long
Dim lcol As Range
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Set lrow = Range("C5:C" & Lastrow)
Lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
Set lcol = Range("C3", Cells(3, Lastcol))
Range("C5").FormulaArray = "=IFERROR(INDEX(DataTable[[Period]:[Period]],SMALL(IF(DataTable[[LP ID]:[LP ID]]=C$2,IF(DataTable[[Fund ID]:[Fund ID]]=$B5,ROW(DataTable[[Fund ID]:[Fund ID]])-ROW(DataTable[[Fund ID]:[Fund ID]]))),1)),"" "")"
Range("C5", lcol.Offset(2)).FillRight
Range("C5", lcol.Offset(2)).FillDown
End Sub
The code below worked for me (with a much simplified array formula).
Sub Six_Continue()
' 25 Jan 2018
Dim Rng As Range
Dim LastRow As Long
Dim LastClm As Long
With ActiveSheet ' better specify by name
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LastClm = .Cells(1, .Columns.Count).End(xlToLeft).Column
Cells(5, 3).FormulaArray = "=IFERROR(INDEX(DataTable[[Period]:[Period]],SMALL(IF(DataTable[[LP ID]:[LP ID]]=C$2,IF(DataTable[[Fund ID]:[Fund ID]]=$B5,ROW(DataTable[[Fund ID]:[Fund ID]])-ROW(DataTable[[Fund ID]:[Fund ID]]))),1)),"" "")"
' .Cells(5, 3).FormulaArray = "= $a1 * $k1:$k5 * C$1"
Set Rng = Range(.Cells(5, 3), .Cells(5, LastClm))
Rng.FillRight
Set Rng = Range(.Cells(5, 3), .Cells(LastRow, LastClm))
Rng.FillDown
End With
End Sub
I'm trying to remove duplicate rows in my Excel Sheet using Visual Basic. The problem is that the amount of Rows will be variable.
Sub RemoveDuplicates()
Range("A1").Select
ActiveSheet.Range(Selection, ActiveCell.CurrentRegion).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
End Sub
The problem here is that Columns:=Array(1, 2) isn't a variable. It should always look from column 1 until the last filled column (the .CurrentRegion).
Can someone please help me!
One way is to create the array dynamically.
Once the block has been defined, we know exactly how many columns the block contains:
Sub luxation()
Dim A1 As Range, rng As Range, cCount As Long
Set A1 = Range("A1")
Set rng = A1.CurrentRegion
cCount = rng.Columns.Count - 1
ReDim ary(0 To cCount)
For i = 0 To cCount
ary(i) = i + 1
Next i
rng.RemoveDuplicates Columns:=(ary), Header:=xlYes
End Sub
Note the encapsulation of ary() in the last line!
Gary's Student has the correct answer.
I'm just having a little fun:
Dim a As Variant
With Range("A1").CurrentRegion
a = Evaluate("Transpose(Row(1:" & .Columns.Count & "))")
ReDim Preserve a(0 To UBound(a) - 1)
.RemoveDuplicates Columns:=(a), Header:=xlYes
End With
Maybe you want something like this:
Sub RemoveDuplicates()
Dim LastCol As Long
Dim LastRow As Long
Dim ColArray As Variant
Dim i As Long
' modify "Sheet1" to your sheet's name
With Sheets("Sheet1")
' find last column with data in first row ("header" row)
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
' find last row with data in column "A"
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
ReDim ColArray(0 To LastCol - 1)
For i = 0 To UBound(ColArray)
ColArray(i) = i + 1
Next i
.Range(.Cells(1, 1), .Cells(LastRow, LastCol)).RemoveDuplicates Columns:=(ColArray), Header:=xlYes
End With
End Sub
I have a worksheet ("Data") with x-columns and y-rows. I want to concatenate the values of a row and the concatenated result should be copied to a second worksheet ("Insert") in the first column of the same row.
I tried this VBA and get an error message
Sub InsertStatementRow()
Dim x As String, rng As Range, rng1 As Range, cel As Range
Dim ColMax As Integer
Dim i As Long
Sheets("Data").Select
Range("A1").Select
ColMax = Cells(1, Columns.Count).End(xlToLeft).Column
With Worksheets("Data")
i = 1
Set rng = Range(Cells(i, 1), Cells(i, ColMax))
End With
For Each cel In rng
x = x & cel.Value
Next
Range(Sheets("Insert").Cells(i, 1)).Value = x
End Sub
Please show me what I am doing wrong by correcting my code. Thanks!
Use some "." :
Set rng = Range(.Cells(i, 1), .Cells(i, ColMax))