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.
Related
I'm trying to implement a macro that looks for the words "TRUE" and "FALSE" in a huge array of data - and then, when found, changes the color of the cells above it.
Specifically, I would like it to color not the TRUE/FALSE-cell, but the 30 cells directly above it. This is where things get tricky... I hope someone can help.
I've tried adapting the below code, but mostly I'm adding it as inspiration at this point.
Sub ChangeColor()
lRow = Range("C" & Rows.Count).End(xlUp).Row
Set MR = Range("C2:C" & lRow)
For Each cell In MR
Select Case cell.Value
Case "Yes"
cell_colour = 4
Case "y"
cell_colour = 4
Case Else
cell_colour = 3
End Select
cell.Interior.ColorIndex = cell_colour
Next
End Sub
Using a datafield array
Looping through a range is always time consuming; this should speed it up.
Caveat: Formatting single cells can maximize file size, so at least I reformat the whole column C to xlColorIndexNone.
Option Explicit
Public Sub Mark30CellsAbove()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MySheet")
Dim v As Variant
Dim i As Long, j As Long, n As Long, m As Long, r As Long
Dim Rng As Range
Dim t As Double
' stop watch
t = Timer
' get last row in column C
n = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
' get values to one based 2dim array
v = ws.Range("C1:C" & n).Value
' clear existing colors over the WHOLE column to minimize file size
ws.Range("C:C").Interior.ColorIndex = xlColorIndexNone
' loop through C2:Cn and mark 30 rows before found condition
For i = 2 To n
' check condition, find string "true" or "false"
If InStr(".true.false.", "." & LCase(v(i, 1)) & ".") > 0 Then
' set range block - fixed rows count 30 above found cell
If i < 32 Then ' only in case of less than 30 rows
Set rng = ws.Range("C2:C" & (i - 1))
Else
Set rng = ws.Range("C" & (i - 30) & ":C" & (i - 1))
End If
rng.Interior.ColorIndex = 4
End If
Next i
MsgBox "Time needed: " & Format(Timer - t, "0.00") & " seconds."
End Sub
Of course you could also loop within If - EndIf, just to see this slower method:
If InStr(".true.false.", "." & LCase(v(i, 1)) & ".") > 0 Then
' Always avoid to loop through a range
' For j = i - 1 To i - 30 Step -1
' If j < 2 Then Exit For ' optional escape if one line under title row
' ws.Cells(j, 3).Interior.ColorIndex = 4
' Next
End If
The code that I posted should only highlight cells in column B whose value is different from the corresponding cell in column A. I tested it and it worked OK.
If you want to try conditional formatting:
Select column B, or the part of column B that you want to colour conditionally.
In the following, I will assume that B1 is the active cell within the selection.
On the Home tab of the ribbon, click Conditional Formatting > New Rule...
Select "Use a formula to determine which cells to format".
Enter the formula =B1<>A1
If the active cell is not in row 1, adjust the formula accordingly. For example, if the active cell within the selection is B3, use =B3<>A3
Click Format...
Activate the Fill tab.
Select the desired fill colour.
Click OK until all dialogs have closed.
Change some values in column A and/or B to see the result.
Refer - https://social.technet.microsoft.com/Forums/ie/en-US/2fffa4d8-bbba-473b-9346-5fce8f0728a8/using-vba-to-change-a-cell-colour-based-on-the-information-in-a-different-cell-excel-2010?forum=excel
First you need to check whether the row of the cell is higher than 30 and then it you can offset to change the color:
Thus instead of this line: cell.Interior.ColorIndex = cell_colour
write this:
If cell.Row > 30 Then cell.Offset(-30, 0).Interior.ColorIndex = cell_colour
This may be done without VBA. You should set up two conditional formatting with formulas. First:
=COUNTIF(OFFSET(INDIRECT(ADDRESS(ROW(), COLUMN())),1,0,29,1), "TRUE")>0
and the same for false. To highlight the cell you just need to use Highlight Cell Rules (the top option for CF).
I would do this with conditional formatting
Mark all your data and press "Conditional Formatting". Enter 2 rules with Use a formula...
First rule is for TRUE. Assuming that you start with Col A:
=COUNTIF(A2:A31;TRUE)
The second rule is similar, just exchange TRUE by FALSE. Below the formula, press the "Format" button to set the color.
Explanation:
I reverted the logic: Instead of searching for TRUE/FALSE and then format the cells above, I look for every cell if it has at least one entry TRUE resp. FALSE in the next 30 cells. However, I have to admit I don't know how fast Excel can handle such a large amount of data.
I've got a column: U. This column has values from U10 till U500.
What I need to get is the last changing value of the column and if it doesn't change then a text "False" or something and if the last changing value is an empty cell, then ignore that..
Column U
11
11
5
11
11
21
For example here the result should be 21.
I've tried comparing two rows and with conditional formatting but with such a big range doing all this for each row is a bit too much.
Does anybody know a good way to do this?
Something like that should do it ...
Sub test()
Dim LastRow As Long, i As Long
With Worksheets("Sheet1") 'your sheet name
LastRow = .Cells(.Rows.Count, "U").End(xlUp).Row 'find last used row in column U
For i = LastRow To 2 Step -1 'loop from last row to row 2 backwards (row 1 can not be compared with row before)
If .Cells(i, "U").Value <> .Cells(i - 1, "U").Value Then 'compare row i with row before. If it changes then ...
MsgBox "Last row is: " & .Cells(i, "U").Address & vbCrLf & _
"Value is: " & .Cells(i, "U").Value
Exit For 'stop if last changing row is found
End If
Next i
End With
End Sub
It loops from last used row in column U to the first row and checks if the current row is different from the row before. If so it stops.
i am not sure of the how you want the output.
IF(AND(RC[-1]<>R[-1]C[-1],ROW(RC[-1])>500,R[-1]C[-1]<>""),RC[-1],"")
try this formula in cells V10:V500
Try this Macro.
First run the AnalyseBefore sub and when you want to check if the value has changed run the AfterAnalyse sub.
Incase you want the range to be dynamic use the code that I have commented and include iCount in your Range calculation
Sub AnalyseBefore()
Dim iCount
Range("U10").Select
iOvalue = Range("U500").Value
'iCount = Selection.Rows.Count
Range("Z1").Value = iOvalue
End Sub
Sub AnalyseAfter()
Dim iCount
Range("U10").Select
iNValue = Range("U500").Value
Range("Z2").Value = iNValue
iOvalue = Range("Z1").Value
If (iOvalue = iNValue) Then
Range("U500").Value = "FALSE"
End If
End Sub
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 am working out a button that can auto sum value at column C that column A = column B
like the picture :
PIC:
I can only copy the value in column C (that the word in column A = column B) to column E so far.
the code
Private Sub CommandButton2_Click()
Dim i As Integer, q As Integer
q = 2
For i = 3 To 100
Range("E" & q).Value = Range("b" & 3).Value
If Range("B" & i).Value = "A-RDL1" And Range("c" & i).Value = "OPEN" Then
Range("E" & i).Value = Range("d" & i).Value
End If
Next i
End Sub
the question 1) is how can I skip the blanks E9 to E17, so the numbers can be continuous? (AFTER CLICK THE BOTTON)
question 2) is it possible to auto sum the Numbers in column E instead of show each?
Thanks a lot and sorry for my poor English...
1) Yes, you can skip those, just carry out a check in the cell value and compare to empty string: Range("").Value2 = "". I personally prefer to do it like this though, to avoid false positives: Len(Trim(Range("").Value2)) = 0.
2) Yes, you can do that. just declare an Integer variable or two and use that to carry out a running count of your values.
I have a workbook with 2 worksheets. On Sheet1 is a list of names in ColC, and on Sheet2 in column C is the same list of names, but spaced out with data in Column D relating to each name almost as a heading. i.e.
Ben 678
700
450
200
Janet 9
23
So I need a vlookup function to Look up the name in ColC Sheet1, and then find the corresponding name in ColC Sheet2, and do an average of the values for that name in ColD until the value in ColC changes (and the next name appears). The number of values in ColD per name changes between 1 and 100 so theres no set range.
(I'm looking for a solution to calculate the average of the last 6 values per name before the next appears - but I can try to modify that later on by myself once I have a structure.)
I am familiar with VBA but no expert, and this is just beyond my ability - I have tried a few things for a few hours and no luck. I have also this code that does a similar thing (I found it on a forum) but only pastes one value and I am not able to modify it enough to suit my needs - it uses VBA to put formulas in specific cells. (it's pretty useless but I thought it was a start)
Sub MCInternet()
'CODE OFF WEB FOR RETURNING VALUE IN COL ... AFTER A LOOKUP OF VALUE IN RANGE - DOESNT ADDRESS RANGE JUST SINGLE CELL
Dim Cll As Range
Dim lngLastRow As Long
lngLastRow = Cells(rows.count, "C:C").End(xlUp).Row
'Sheets("Unpaid List").Range("H2:H" & lngLastRow).ClearContents
For Each Cll In Sheets("Sheet2").Range("C1:C" & Sheets("Sheet2").Range("C1").End(xlDown).Row)
'Cll.Offset(, 6).Formula = "=Vlookup(" & Cll.Address & ", " & Sheets("Sheet1").Name & "!A:C,1,False)"
Cll.Offset(, 6).Formula = "=Vlookup(" & Cll.Address & ", " & Sheets(Sheets.count).Name & "!A:C,1,False)"
Next Cll
End Sub
I think it's better to define in a new module a Public Function like:
Public Function FindP(xx As Range) As Long
Application.Volatile
Dim FoundIndex
Dim SumFound, i As Long
Set FoundIndex = Sheets("Sheet2").Range("C:C").Find(xx.Value)
If (FoundIndex Is Nothing) = True Then
FindP = 0
Exit Function
Else
SumFound = 0
For i = 0 To 100
If (FoundIndex.Offset(i, 0) = "") Or (FoundIndex.Offset(i, 0) = xx.Value) Then
SumFound = SumFound + FoundIndex.Offset(i, 1).Value
Else
Exit For
End If
Next
FindP = SumFound
End If
End Function
and in every cells in the sheet1:
D1 -> =FindP(C1)
and autocomplete.
The function search in the column C of the sheet2 the name, after loop to sum every value if the name in column C it's equal (1st line) or empty (2nd ... n line).