I can't solve my vba problem. I need your help.
I would like to get the cell in the next column.
if Loulou =A3, i would like plage1 = B3
If loulou =A5, i would like plage 1 = B5
Dim Loulou As String
Dim plage1 As String
Loulou = Cells(Int(Rnd * 20) + 1, 1).Select
plage1 = Cells(Loulou, 1)
I tried different things, to put offset on a variable, but it does not work.
Thank you for you help
Please, try the next way:
Sub testNextColVal()
Dim Loulou As Range, plage1 As Range
Set Loulou = Cells(Int(Rnd * 20) + 1, 1)
Set plage1 = Loulou.Offset(, 1)
Debug.Print plage1.Address, plage1.Value
MsgBox Plage1.Address & " - " & plage1.Value
End Sub
Related
In VBA Excel, if I have a table. How do I check the cells outside the table in all 4 sides of it, for 10 rows and 10 columns, as empty or not?
Thanks
Jeevan
You could use this function:
Option Explicit
Function NonBlankCellsOutside(rng As Range, rowsOutside As Long, colsOutside As Long)
Dim outside As Range
Dim rowsBefore As Long
Dim colsBefore As Long
rowsBefore = IIf(rng.Row <= rowsOutside, rng.Row - 1, rng.Row - rowsOutside)
colsBefore = IIf(rng.Column <= colsOutside, rng.Column - 1, rng.Column - colsOutside)
Set outside = rng.Offset(-rowsBefore, -colsBefore) _
.Resize(rng.Rows.Count + rowsBefore + rowsOutside, _
rng.Columns.Count + colsBefore + colsOutside)
NonBlankCellsOutside = WorksheetFunction.CountA(outside) _
- WorksheetFunction.CountA(rng)
End Function
Example use with a normal range:
Dim ok As Boolean
ok = NonBlankCellsOutside(Worksheets(1).Range("C20:F50"), 10, 10) = 0
If Not ok Then MsgBox "There are non-blank cells in the neighbourhood"
Another example with a named table:
Dim num As Long
num = NonBlankCellsOutside(ActiveSheet.ListObjects("Table1").Range, 5, 5)
MsgBox "There are " & num & " non-blank cells around the table"
You can do this with in-cell formulae.
Given a table named Table1 whose top-left corner is no closer to the top or to the left than K11, and the following formulae, the value in A5 will give you your answer:
A B C
1
2 Range start =ROW(Table1)-10 =COLUMN(Table1)-10
3 Range end =ROW(Table1)+ROWS(Table1)+9 =COLUMN(Table1)+COLUMNS(Table1)+9
4
5 =AND(B2>0, B3>0, COUNTA(INDIRECT("r"&B2&"c"&C2&":r"&B3&"c"&C3, FALSE))=COUNTA(Table1[#All]))
Here I have something that works for any named table, as long as its first cell is no closer to the edges than K11.
Sub checkSurroundings()
Dim tws As Worksheet
Dim tb1 As ListObject
Dim tb1_address As String
Dim c() As String 'Table range, first and last cell
Dim rngL, rngR, rngU, rngD As Range
Dim tmpRange As Range
Dim cnt As Integer
Set tws = ThisWorkbook.Worksheets("Sheet1")
Set tb1 = tws.ListObjects("Table1")
tb1_address = tb1.Range.Address
'Debug.Print tb1_address
c() = Split(tb1_address, ":", -1, vbTextCompare)
'Debug.Print c(0)
'Debug.Print c(1)
cnt = 0
With tws
'Range Left
Set rngL = Range(.Range(c(0)).Offset(-10, -10), .Cells(.Range(c(1)).Row + 10, .Range(c(0)).Column - 1))
'Range Right
Set rngR = Range(.Cells(.Range(c(0)).Row - 10, .Range(c(1)).Column + 1), .Range(c(1)).Offset(10, 10))
'Range Up
Set rngU = Range(.Range(c(0)).Offset(-10, 0), .Cells(.Range(c(0)).Row - 1, .Range(c(1)).Column))
'Range Down
Set rngD = Range(.Cells(.Range(c(1)).Row + 1, .Range(c(0)).Column), .Range(c(1)).Offset(10, 0))
End With
For i = 1 To 4
Select Case i
Case 1
Set tmpRng = rngL
Case 2
Set tmpRng = rngR
Case 3
Set tmpRng = rngU
Case 4
Set tmpRng = rngD
End Select
For Each cell In tmpRng
If Not IsEmpty(cell) Then
cnt = cnt + 1
End If
Next cell
Next i
If cnt > 0 Then
MsgBox ("The area around Table1 (+-10) is not empty. There are " & cnt & " non-empty cells.")
Else
MsgBox ("The area around Table1 (+-10) is empty.")
End If
End Sub
the vba code is:
Sub D()
Dim a As String
Dim wb As Workbook
Dim file As Variant
Dim arr1() As Variant
Dim arr2() As Variant
Dim arr3() As Variant
Dim arr() As Variant
Dim arr4() As Variant
Dim arr5() As Variant
Dim arr6() As Variant
Dim t As Integer
ActiveWorkbook.Activate
ActiveSheet.Activate
arr4 = Range("J2:J256")
arr5 = Range("K2:K256")
arr6 = Range("L2:L256")
ActiveSheet.Activate
For Row = 1 To UBound(arr4, 1)
If arr4(Row, 10) = "IS" And arr5(Row, 11) = "IS" And arr6(Row, 12) = "IS" Then
Cells(Row + 1, 13) = "UPDATE AB SET S=" & Cells(Row + 1, 6) & "WHERE C=" & Cells(Row + 1, 3) & ";"
End If
Next Row
End Sub
I am getting error as Subscript Out of range at arr4(Row,10)= when debugged.Can u help in rectifying the error so that the code may be able to function correctly.
I think the problem lies in your understanding of the array. You are using absolute cell references for your array (which is relative). The first index of an array, ie (1, 1), references the first cell in your range, so for Range("K2:K256") arr(1, 1) will be referencing the value of cell "K2", arr(10, 1) will be referencing the value of cell "K11", etc.
As LMM9790 points out, if you wanted to keep your code structure as is then it could simply be written as:
If arr4(Row, 1) = "IS" And arr5(Row, 1) = "IS" And arr6(Row, 1) = "IS" Then
Cells(Row + 1, 13) = "UPDATE AB SET S=" & Cells(Row + 1, 6) & "WHERE C=" & Cells(Row + 1, 3) & ";"
End If
However, I'd have to ask why you need so many arrays, one for each column? Given that arr4, 5 and 6 all have the same row dimension, you could simply have one array that contains all of the columns. Moreover, you could have one array for the entire dataset, amend the applicable value, then rewrite the array to the Worksheet.
Elsewhere the code is a little odd. Is there a reason, for example, that you would activate an active sheet and book? You also have several unused variables - are you intending to use these later?
Your whole code could be simplified to this:
Sub D()
Dim ws as Worksheet
Dim r As Integer
Dim v As Variant
Set ws = ActiveWorkbook.Worksheets("Sheet1") 'name as appropriate
v = ws.Range("C2:M256").Value2
For r = 1 To UBound(v, 1)
If r < Ubound(v, 1) then
If v(r, 8) = "IS" And v(r, 9) = "IS" And v(r, 10) = "IS" Then
v(r + 1, 11) = "UPDATE AB SET S=" & v(r + 1, 4) & _
" WHERE C=" & v(r + 1, 1) & ";"
End If
End If
Next
'...
ws.Range(("C2:M256").Value = v
End Sub
Regarding the out of range error, since arr4, arr5 and arr6 only contain one column you cannot access for example the 10th column of them (which is done in your code by arr4(Row, 10). Does you code work as wanted if you use the following?
Sub D()
Dim a As String
Dim wb As Workbook
Dim file As Variant
Dim Row As Integer
Dim arr1() As Variant
Dim arr2() As Variant
Dim arr3() As Variant
Dim arr() As Variant
Dim arr4() As Variant
Dim arr5() As Variant
Dim arr6() As Variant
Dim t As Integer
ActiveWorkbook.Activate
ActiveSheet.Activate
arr4 = Range("J2:J256")
arr5 = Range("K2:K256")
arr6 = Range("L2:L256")
For Row = 1 To UBound(arr4, 1)
If arr4(Row, 1) = "IS" And arr5(Row, 1) = "IS" And arr6(Row, 1) = "IS" Then
Cells(Row + 1, 13) = "UPDATE AB SET S=" & Cells(Row + 1, 6) & "WHERE C=" & Cells(Row + 1, 3) & ";"
End If
Next Row
End Sub
Ok this is what I tried with:
Sheets("ProDiver ored").Range("X" & i).Value = Sheets("ProDiver ored").Range("W2:W" + i).Value
But it doesn't work.
What I am trying to do is to make the macro take the W1:Wx and summarize these on the X column.
It should be looking like this in other words:
X1 = W1
X2 = W1 + W2
X3 = W1 + W2 + W3
X4 = W1 + W2 + W3 + W4
And so on.
Can you guys direct me on how to do this? I want it for a VBA Excel macro of course.
As Siddharth suggested (and slightly changed from the comment):
This will paste the formula from X1 down to the bottom of the data range:
Sub JustFormula()
With ThisWorkbook.Worksheets("Sheet1")
.Range(.Cells(1, 24), .Cells(Rows.Count, 23).End(xlUp).Offset(, 1)).Formula = "=SUM($W$1:$W1)"
End With
End Sub
A slight change to the procedure and you can have just the values instead:
Sub JustValues()
Dim MyRange As Range
With ThisWorkbook.Worksheets("Sheet1")
Set MyRange = .Range(.Cells(1, 24), .Cells(Rows.Count, 23).End(xlUp).Offset(, 1))
End With
MyRange.Formula = "=SUM($W$1:$W1)"
MyRange.Value = MyRange.Value
End Sub
If your workbook takes a while to calculate you may want to put a DoEvents before the .Value = .Value line.
Try
Sheets("ProDiver ored").Range("X" & i).Value = Application.Sum(Sheets("ProDiver ored").Range("W1:W" & i))
above assumes you do not need the formula to add values up just the result of the calculation
If you want to have all sub parts of the concatenation like in your example, you should have a loop: (untested!)
Dim cell As Object
Dim j As Integer
Dim newString As String
Set newString = ""
Set j = 0
For cell in Sheets("ProDiver ored").Range("W:W") 'entire column W
newString = newString + cell.Value
Range("X" & j).Value = newString
j = j + 1
Next
Try with this. I already tested it. It work well.
Public Sub summarizeValue()
Dim row As Integer
Dim summarize As Integer
Dim dataSheet As Worksheet
'Set start row
row = 1
'Getting data sheet
Set dataSheet = ThisWorkbook.Worksheets("sheetname")
'We need some break point, so I used "Do While" instead of "For" which is looping all cell.
'Loop column cells until blank
Do While dataSheet.Range("W" & row) <> ""
'If adding integer, use "+" sign
'If adding string, use "&" sign
summarize = summarize + dataSheet.Range("W" & row)
'Set summarize value into result cell
dataSheet.Range("X" & row) = summarize
'Increase row
row = row + 1
Loop
End Sub
I'm attempting to grab strings from a specific range of one worksheet and output the array onto another sheets range. Unfortunately the resulting code gives me no output of any sort.
Thank you for the help in advance.
Dim strFunds As String
Dim varItemName As Variant
Dim strItemName() As String
Dim iRow As Long
Dim rngMyRange As Range
Sub DataGrab()
ActiveWorkbook.Sheets("Returns").Activate
Set rngMyRange = Range("A5:A100")
varItemName = rngMyRange
ReDim strItemName(LBound(varItemName, 1) To UBound(varItemName, 1))
ActiveWorkbook.Sheets("Data").Activate
Range("A3:A" & UBound(strItemName) + 1) = WorksheetFunction.Transpose(strItemName)
End Sub
Sub Main()
Dim rngArr
rngArr = Sheets("Returns").Range("A5:B100").Value
Sheets("Data").Range("A3").Resize(UBound(rngArr) + 1, 2) = rngArr
End Sub
EDIT: Oops didn't see me how's answer above. This answer is pretty much the same thing.
Try this.
First, change varItemName to an array:
Dim varItemName() As Variant
Then:
Sub DataGrab()
ActiveWorkbook.Sheets("Returns").Activate
Set rngMyRange = Range("A5:A100")
varItemName = rngMyRange.Value
'ReDim strItemName(LBound(varItemName, 1) To UBound(varItemName, 1))
ActiveWorkbook.Sheets("Data").Activate
Range("A3").Resize(1, UBound(varItemName) + 1) = WorksheetFunction.Transpose(varItemName)
End Sub
That is assuming you want to convert your columnar data into a single row. If not, do this on the last line instead:
Range("A3").Resize(UBound(varItemName) + 1, 1) = varItemName
You are not assigning any values to strItemName. Here's a version that just keeps everything in varItemName.
ActiveWorkbook.Sheets("Returns").Activate
Set rngMyRange = Range("A5:A100")
varItemName = rngMyRange.Value
ActiveWorkbook.Sheets("Data").Activate
Range(Cells(3, 1), Cells(3, UBound(varItemName))) = WorksheetFunction.Transpose(varItemName)
UPDATE: If you don't need to save varItemName, you can use this shorter version:
Set rngMyRange = Range("A5:A100")
ActiveWorkbook.Sheets("Data").Activate
Range(Cells(3, 1), Cells(3, 100)) = WorksheetFunction.Transpose(rngMyRange)
Function ChangeColVal(ByVal Rng As Range, ByVal ValueToChange As Integer)
Dim Cell1, Cell2 As String
Dim PosOfColon, TotalCell, Sum As Integer
PosOfColon = InStr(1, Rng.Address, ":")
Cell1 = Left(Rng.Address, PosOfColon - 1)
Cell2 = Right(Rng.Address, Len(Rng.Address) - PosOfColon)
If Left(Cell1, 2) = Left(Cell2, 2) Then
TotalCell = Rng.Count
For i = 0 To TotalCell
If IsNumeric(Range(Cell1).Offset(i, 0).Value) = False Then
GoTo 112:
End If
Cell2 = Range(Cell1).Offset(i, 0).Address
Sum = Range(Cell2).Cells.Value + ValueToChange
On Error GoTo 111
'Here getting error...
Range(Cell2).Value = Sum
GoTo 112
111:
MsgBox (Err.Number & ":" & Err.Description)
112:
Next i
Else
MsgBox ("Select Column only...")
End If
End Function
I wants to increase or decrease cell value of selected range.
I am getting error in line Range(Cell2).Value = Sum
Edit
thanx for reply, in line Range(Cell2).Value = Sum, Cell2 is pointing to cell address like $E$6.
If there is any option other than that pls let me know
ok Mihir. You cannot use a UDF (User Defined Function) to modify other cells then the one the formula is used in. However, there is a workaround it by calling your function from a sub. I will show you how to do it.
Open a new workbook and make your spreadsheet look like the picture below.
Fill in some random numbers in column A of Sheet1
Then open VBE and create a new module ( Project Explorer > Insert > Module ) and paste the code from below
Option Explicit
Sub ChangeColumnValue()
Dim rng As Range
Set rng = Selection
Dim inp As String
inp = InputBox("Value to change:")
Call ChangeColVal(rng, CLng(inp))
End Sub
Private Function ChangeColVal(ByRef rng As Range, ByVal ValueToChange As Long)
Dim Cell1, Cell2 As String
Dim PosOfColon, TotalCell, Sum As Long
PosOfColon = InStr(1, rng.Address, ":")
Cell1 = Left(rng.Address, PosOfColon - 1)
Cell2 = Right(rng.Address, Len(rng.Address) - PosOfColon)
If Left(Cell1, 2) = Left(Cell2, 2) Then
TotalCell = rng.Count
Dim i&
For i = 0 To TotalCell - 1
If Not IsNumeric(Range(Cell1).Offset(i, 0).Value) Then
GoTo 112:
End If
Cell2 = Range(Cell1).Offset(i, 0).Address
Sum = Range(Cell2).Cells.Value + ValueToChange
On Error GoTo 111
Range(Cell2).Value = Sum
GoTo 112
111:
MsgBox (Err.Number & ":" & Err.Description)
112:
Next i
Else
MsgBox ("Select Column only...")
End If
End Function
Then, go back to your spreadsheet and select your range with your mouse like this:
Ok, now hit ALT + F8 to View Macros and run the ChangeColumnValue macro.
You will be prompt for a Value to Change and all cells within selected range will be Increased/Decreased by that Value.
and your final result if you type 5 in the prompt box will look like this
Good luck!
finally here is the solution.
Sub ChangeRowValues()
Dim rng As Range
Dim R As Range
Dim ValueToChange As Long
Dim Cell1, Cell2 As String
Dim PosOfColon, TotalCell, Sums, i As Integer
Set rng = Selection
ValueToChange = Val(InputBox("Enter Number to Change:", "Enter Number...", 0))
PosOfColon = InStr(1, rng.Address, ":")
Cell1 = Left(rng.Address, PosOfColon - 1)
Cell2 = Right(rng.Address, Len(rng.Address) - PosOfColon)
If UCase(Left(Cell1, 1)) = UCase(Left(Cell2, 1)) Then
TotalCell = rng.Count
For i = 0 To TotalCell - 1
'To Chnage Values of Row....
Range(Cell1).Offset(0, i).Select
'To Chnage Values of Colum....
'Range(Cell1).Offset(i,0).Select
If IsNumeric(ActiveCell.Value) = True Then
ActiveCell.Value = Val(ActiveCell.Value) + ValueToChange
End If
Next i
Else
MsgBox ("Select Row only...")
End If
End Sub
range() function input is cell address, for example, range(a1:b2;g1:h4), you cannot input some result in it.