I am trying to do a For-Next loop,
at the beginning, I will select row 1&2, then row 1&3, then row 1&4 ...etc
I tried the following but excel would treat my "i" as column i instead of the row number. How this problem can be fixed?
Sub test123()
Dim i As Long
For i = 2 To 51
Range("1:1,i:i").Select
Selection.Copy
'other code
Next i
End Sub
You can't insert your variable names within a String - you need to include the value of the variable within the String instead.
Sub test123()
Dim i As Long
For i = 2 To 51
Range("1:1," & i & ":" & i).Select
Selection.Copy
'other code
Next i
End Sub
Note: There should be no need to actually Select the ranges:
Sub test123()
Dim i As Long
For i = 2 To 51
Range("1:1," & i & ":" & i).Copy
'other code
Next i
End Sub
Another alternative way to go is using the Union, between each pair of Rows you want to copy:
Option Explicit
Sub test123()
Dim i As Long
For i = 2 To 51
Union(Rows(1), Rows(i)).Copy
'other code
Next i
End Sub
Note: there's ne need to Select the range before copying it, you can directly use the copy on the fully qualified Range.
Related
I have an excel sheet where I am doing a VlookUP using VBA. The problem is that I extract information, and the amount is always different. I want to find a way to add to the code that will add information until there is no more information to add.
Here is the code that works but only for the cells I put in:
Sub vLook()
With ThisWorkbook.Worksheets("EODComponents").Range("f5:F200")
.Formula = "=VLOOKUP(C5,($H$5:$i$34),2,FALSE)"
.Value = .Value
End With
End Sub
You can set a lastRow:
Sub vLook()
Dim lastRow as Long
With ThisWorkbook.Worksheets("EODComponents")
lastRow = .Cells(.Rows.Count,6).End(xlUp).Row
With .Range("f5:F" & lastRow)
.Formula = "=VLOOKUP(C5,($H$5:$i$34),2,FALSE)"
.Value = .Value
End With
End With
End Sub
Maybe you can try to use a Do while-loop?
If you put the while statement right, this will continue until the statement becomes false, in your case; there is no more information to add.
You can use the Len()-function to check the length of the text/value inside a cell, when this is zero you can assume the cell is empty.
More information about this item can be found here.
Example:
Public Sub Something()
Dim i As Integer
i = 1
Do While (Len(Cells(i, 1).Text) > 0)
i = i + 1
Loop
MsgBox "The next row of column 'A' is empty: A" & i
End Sub
Hope this helps.
I have a workbook and I need to find the NO values on ROW G (Row 7) and then copy the line that NO belongs to a new sheet (TAB) called summary, in my case it is listed as sheet 18.
I need to search on all sheets though from Sheet 1 to Sheet 17 in their G Rows for NO's.
I have a code I have found online and amend it to work with my criteria. But it does not seem to work as I would like it to it keeps coming up with errors.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nxtRow As Integer`enter code here`
'Determine if change was to Column G (7)
If Target.Column = 7 Then
'If Yes, Determine if cell = NO
If Target.Value = "NO" Then
'If Yes, find next empty row in Sheet 18
nxtRow = Sheets(18).Range("F" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 18
Target.EntireRow.Copy _
Destination:=Sheets(18).Range("A" & nxtRow)
End If
End If
End Sub
Thank you in advance.
Vasilis.
http://s38.photobucket.com/user/Greekcougar/media/screenshot9_zpslhtkkfue.jpg.html
http://s38.photobucket.com/user/Greekcougar/media/sub%20macro_zpsngyjtsj9.jpg.html
Below is the code for the same. It has two sub procedures initiate and applyFilterAndCopy. In initiate you can specify the no. of sheets(sheetCount In below code I have mentioned as 2) you need to scan. While calling the second sub procedure inside first(initiate) you need to specify the column number and the text you are searching for as variables to the second sub procedure(Call applyFilterAndCopy(i, 1, "No") here I have mentioned as 1 i.e. 1st column and String to be searched as No in quotes). Please note the sheet names need to be in the format Sheet**** and summary sheet name as Summary case sensitive as mentioned in your description.
Sub initiate()
Worksheets("Summary").UsedRange.Delete
Dim i As Integer, sheetCount As Integer
sheetCount = 2
For i = 1 To sheetCount
Call applyFilterAndCopy(i, 1, "No")
Next i
End Sub
Sub applyFilterAndCopy(sheetNo As Integer, searchInColumn As Integer, textToSearch As String)
Worksheets("Sheet" & sheetNo).AutoFilterMode = False
Worksheets("Sheet" & sheetNo).Range("A1").AutoFilter Field:=searchInColumn, Criteria1:=textToSearch
DR = Worksheets("Summary").UsedRange.SpecialCells(xlCellTypeLastCell).Row
If IsEmpty(DR) = True Or DR = 1 Then
Worksheets("Sheet" & sheetNo).UsedRange.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Summary").Range("A1")
Else
Worksheets("Sheet" & sheetNo).UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Summary").Range("A" & DR + 1)
End If
End Sub
Vba is not necessary for this. An easy way to do this is using a formula and filter.
Add a column to the sheet that looks at the previous row and checks if no is there. Then filter this column and you can then just copy and paste to your summary tab.
I'm making a macro on Excel 2013 to get the URL from a column (Column "f") and put it on the next column (Column "G") I already make a code but it doesn't work as I want
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
With rngTarget.Parent
.Pictures.Insert strShpUrl
.Shapes(.Shapes.Count).Left = rngTarget.Left
.Shapes(.Shapes.Count).Top = rngTarget.Top
End With
End Sub
Sub Obtener_imagen()
On Error Resume Next
For i = 2 To 3
Call GetShapeFromWeb(Range("f" & i).Value, Hoja1.Range("a65536").End(xlUp).Offset(6, i))
Next i
End Sub
If I understand correctly, this is what you are trying to achieve
Sub Obtener_imagen()
Dim fila as Integer,ultima_fila as Integer
ultima_fila =Hoja1.Range("F65536").End(xlUp).row
For fila =1 To ultima_fila
With Range("G" & fila).Parent
.Pictures.Insert Range("F" & fila)
.Shapes(.Shapes.Count).Left = ("G" & fila).Left
.Shapes(.Shapes.Count).Top = ("G" & fila).Top
End With
Next i
End Sub
The problem is that you're putting this in the Range Range("a65536").End(xlUp).Offset(6, i)
So you're offsetting by i from column A. Change that i to a 7 to specify column G, or another variable if you need it dynamic.
Your range statement is doing the following:
Go To Cell A65536
Press Ctrl + Up to find the last used row in column A.
Go down 6 rows (.Offset(6)
Go right i columns (either 2 or 3, which means either column B or C)
Insert the image there.
This will cause you problems if column A doesn't have the same number of rows populated as column G, and it also sounds like you don't want to offset by 6 rows either.
I have a VBA calculation that is looping to recalculate cells 500 (or whatever the iteration is) times. For each recalculation there is an output which I want a record of after the loop is complete. I have tried a few different ways but I can't seem to get it right. Here is an example of what I have so far.
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Iteration = Range("C4")
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
Range("C20").Copy
Range("J" & Rows.Count).End(xlUp).Offset(1).Select.PasteSpecial xlPasteValues
Next i
End Sub
I think the only problem is that you are selecting in the same line as pasting special. Try this:
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Iteration = Range("C4")
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
Range("C20").Copy
Range("J" & Rows.Count).End(xlUp).Offset(1,0).PasteSpecial Paste:=xlPasteValues
Next i
End Sub
Try this:
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Dim val as Variant
Iteration = Range("C4")
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
val = Range("C20").Value
Debug.print "i: " & i & " val: " & val
Range("J" & Rows.Count).End(xlUp).Offset(1) = val
Next i
End Sub
If the correct values do not show up in the immediate window, the problem lies elsewhere. Obviously, delete the debug.print statement, if the code works as expected.
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Iteration = Range("C4")
Dim RLog As Range ' prepare a range for the log
Set RLog = [C22] ' or wherever you want to start the log range
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
RLog(i,1) = [C20] ' write the current result to the range (short notation [C20] is aequivalent to Range("R20")
Next i
End Sub
I need to apply "IF "formula in whole C column till has last value in the sheet using VBA .
but i am getting error 438 if i use the following code . Plz help me
Sub test11()
With Sheets("Sheet")
.Range("c1:c" & .Cells(.Rows.Count, "A").End(xlUp).Row).Formula = "=IF(B1="",TRIM(A1),TRIM(B1))"
End With
End Sub
So your sheet name is Sheet or Sheet1? And OP mentioned Sheet name is Sheet2. That removes one error. Secondly, you need to set D column as .Cells(.Rows.Count,"D").End(xlUp).Row) instead of A column.
Here is a very ugly code to try out: It takes last used row in count into the Long variable. Then set the range accordingly for setting up the formula using AutoFill.
Sub test11()
Dim l As Long
l = Sheets(1).Range("d1:d" & Sheets(1).Cells(Sheets(1).Rows.Count, "D").End(xlUp).Row).Count
With Sheets("Sheet1")
.Range("d1").Formula = "=IF(IsNull(B1),TRIM(A1),TRIM(B1))"
.Range("d1").AutoFill Destination:=Range("d1:d" & l), Type:=xlFillDefault
End With
End Sub
Your logic seems a bit strange, but this works:
Sub test11()
With Sheets("Sheet1")
.Range(.Range("c1"), .Range("C" & .Rows.Count).End(xlUp)) = "=IF(B1="""",TRIM(A1),TRIM(B1))"
End With
End Sub
You need to double the quotes within quotes in VBA.
Another variant:
Sub test12()
With Sheets("Sheet1")
Intersect(.Range("c1").CurrentRegion, .Range("C:C")).Formula = "=IF(B1="""",TRIM(A1),TRIM(B1))"
End With
End Sub