Delete a selected segment of a row within a loop - vba

I have a pretty big spreadsheet (goes all the way to Cell BP584). I'm trying to loop through the values in row S starting at S5 and - where they match my designated variable value - delete certain cells in the area where they're found. I only want to delete the cells from column P to AG - not the entire row. I've placed my code below (VBA). It's not working.
Sub DeleteSelect()
Sheets("DADOS").Select
Dim CurrentDate As Date
CurrentDate = Range("AH2").Value
For i = 5 To 105
If Range("S" & i).Value = CurrentDate Then Range("Pi:AGi").Delete
Next
End Sub

You are pretty close, it just looks like a syntax error in your Delete statement:
Sub DeleteSelect()
Sheets("DADOS").Select
Dim CurrentDate As Date
CurrentDate = Range("AH2").Value
For i = 5 To 105
If Range("S" & i).Value = CurrentDate Then
' Caution - Delete will shift cells.
' You might want to consider ClearContents instead.
Range("P" & i & ":AG" & i).Delete(xlShiftToLeft)
End If
Next
End Sub
As noted in the code above, you may want to consider using ClearContents instead of Delete so you do not have to worry about shifting cell positions.

Related

VBA Excel Format Range when value is found

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.

Excel VBA getting an image from url

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.

excel VBA : how to skip blank cells between 2 cells that contain values?

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.

Count rows for merged cells

I have a problem to count the number of rows for each block of merged cells, in Excel.
I have a value on A1. If I merge cells A1 to A4 the value appears centered, on the range A1-A4.
Then I have another value in A5. If I merge cells A5 to A12, this second value appears centered on this second block of cells.
What I want is to count number of rows for each block of merged cells.
I have tried to use VBA programming to detect these number of rows, with function "MergeArea" and "CurrentRegion.Count" but the program detects that the two blocks are contiguous and counts 12 rows, instead of 4 and then 8.
If it detects "4" first, I could put the correct instruction on a loop and then detect "8".
There are several downsides to merged cells in terms of VBA but here is a simple method to try.
My sheet looks like this:
Code:
Sub CountMergedRows()
For i = 1 To 20
RowCount = Range("A" & i).MergeArea.Rows.Count
If RowCount > 1 Then
MsgBox ("Cell [A" & i & "] has " & RowCount & " merged rows")
i = i + RowCount
End If
Next i
End Sub
Results are two message boxes that appear like this:
Method Range("A" & i).MergeArea.Rows.Count suggested by Portland Runner works fine, however the function has slightly incorrect logic as it is missed that Next also increments i, so it is more correct to write:
Sub CountMergedRows()
For i = 1 To 20
RowCount = Range("A" & i).MergeArea.Rows.Count
If RowCount > 1 Then
MsgBox ("Cell [A" & i & "] has " & RowCount & " merged rows")
i = i + RowCount - 1 'note -1 here
End If
Next i
End Sub

Am I using the isnumeric function correctly?

This program is to convert a column of data from cumulative to non-cumulative. On my sheet I have A1, B1, and C1 with the text Non-Cumulative, Cumulative, and Converted, respectively. I have numbers 1 to 10 beneath A1, then them summed cumulatively beneath B1. C1 is where I want to convert column B back to non-cumulative.
The IsNumeric is used to make the first row of data in C equal to the first row of data in B. It should detect that the title is above the number it is evaluating, thus knowing that no calculations have to be performed. For the rest of them, it'll see that the number above the one it is evaluating is a number, and thus the calculation has to be done.
My problem is that it isn't working. I think the reason is because IsNumeric() keeps coming back as false. Is there a different function I should be using? Do cell references not work in IsNumeric?
Here's the program!
Option Explicit
Dim i As Variant
Sub Conversion()
Sheets("Test Sheet").Select
For i = 1 To 10
If IsNumeric("B" & i) = False Then
Range("C" & i + 1) = Range("B" & i + 1)
Else: Range("C" & i + 1) = Range("B" & i + 1) - Range("B" & i - 1)
End If
Next
End Sub
The way you wrote your code is logical, just a minor syntax changes you need initially. However,
It's also best to check if the range is empty first...
Then check on if the value is numeric.
Better even, if you set the Range into a Range object and use offset
Code:
Option Explicit '-- great that you use explicit declaration :)
Sub Conversion()
Dim i As Integer '-- integer is good enough
Dim rngRange as Range
'-- try not to select anything. And for a cleaner code
Set rngRange = Sheets("Test Sheet").Range("B1")
For i = 1 To 10
If (rangeRange.Offset(i,0).value) <> "" then '-- check for non-empty
If IsNumeric(rangeRange.Offset(i,0).value) = False Then
rangeRange.Offset(i+1,1) = rangeRange.Offset(i+1,0)
Else
rangeRange.Offset(i+1,1) = rangeRange.Offset(i+1,0) - rangeRange.Offset(i-1,0)
End If
End if
Next i '-- loop
End Sub
To make your code more dynamic:
Another suggestion, you may simply Application.WorkSheetFunction.Transpose() the entire B column range that you need to validate into a variant array
Process the array and Transpose back to the Range with column B and C.
By doing so, you may omit setting for loop size manually but setting it using Lower and Upper bound of the array ;)
You need to check if the range of B i is numeric, not the string "B" & i
and rather than selecting the sheet, simply using a parent identifier like:
sheets("sheet1").range("B" & i)
This will help you avoid errors in your code
For i = 1 To 10
If IsNumeric(sheets("test sheet").range("B" & i).value) = False Then
Range("C" & i + 1) = Range("B" & i + 1)
Else: Range("C" & i + 1) = Range("B" & i + 1) - Range("B" & i - 1)
End If
Next