If 0 clear contents for multiple columns - excel

I'm wondering how to make the following code work for multiple columns (D:P)? I've already tried adding & ":"P" & "65536" to the range, without success.
For i = 5 To Range("D" & "65536").End(xlUp).Row Step 1
If Application.WorksheetFunction.CountIf(Range("D" & i), "0") = 1 Then
Range("D" & i).ClearContents
End If
Next i

You can use Range("D5:P65536").Replace What:=0,Replacement:="" to Replace all at once.

Loop through the actual column and use the Find() method to perform your search. If your value exists in that range (range = column), then you can clear the contents that way.
Sub test()
' Just for illustration on the columns
Const D& = 4: Const P& = 16
Dim ws As Worksheet, col As Long
Set ws = ThisWorkbook.Worksheets(1)
For col = D To P
If Not ws.Columns(col).find(What:="0", LookAt:=xlWhole) Is Nothing Then
ws.Columns(col).ClearContents
End If
Next col
End Sub

Related

Usng variables as column names within a range

can i have some assistance with the syntax to refer to a an entire row (or column) within a range ?
I know that i can specify a row (row 1) to perform some functions like this:
With ws1.Range("1:1")
....
End With
How do i specify a row using a variable ? For example
With ws1.Range("rowVariable:rowVariable")
...
End With
Test Data:
freqPlan freqChan freq2Update fNote
Narrow81 AB31' 90.111110 N67
Narrow81 B842 99.880000 N68
Narrow81 B842' 99.880000 N68
My Code:
Sub remFootnote()
Dim ws1 As Worksheet
Set ws1 = Sheet1
Dim lastRow, Index, i As Integer
Dim freq2Update, freqPlan, freqChan, fNote As String
freq2Update = 99.88
freqPlan = "Narrow82"
freqChan = "B842'"
fNote = "N68"
lastRow = ws1.Range("A1").End(xlDown).Row
For Index = 2 To lastRow
i = Index
If ws1.Range("A" & i).Value = "Narrow81" Then
If ws1.Range("B" & i).Value = "B842'" Then
With ws1.Range("i : i") '**this is the line i have issues with**
Set d = .Find(fNote, LookIn:=xlValues) 'when fnote is found in Row "i"
d.ClearContents 'delete it
End With
End If
End If
Next Index
End Sub
I have the watch window activated to see my variables and the code above works fine up to the line where i try to execute this line:
With ws1.Range("i : i")
I have tried the following variations to no avail:
With ws1.Range("i : i")
With ws1.Range(i:i)
With ws1.Range(i":"i)
Any assistance would be greatly appreciated.
A few issues here:
Just use Range.EntireRow
Not sure why you need variables Index and i - since they are the exact same thing, just use one
You need to add Dim d as Range to your code. Also, you have to assign variable types each time. The comma seperated method you are using is not correct
You need to code for the chance that your value is not found in the row you are searching. So, check to make sure your range variable d is not Nothing before taking any action
The better way to find the last row is to go from bottom up (ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row)
Putting all this together:
'Poper way to declare variables
Dim lastRow as Long, i As Long
Dim freqPlan as String, freqChan as String, fNote As String
Dim freq2Update as Double
Dim d as Range
'Assign variable values here
ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
'Simplified loop
For i = 2 To lastrow
If ws1.Range("A" & i) = "Narrow81" And ws1.Range("B" & i) = "B842" Then
Set d = ws.Range("A" & i).EntireRow.Find(fNote, LookIn:=xlValues)
If Not d Is Nothing Then d.ClearContents
Set d = Nothing
End If
End If
Try replacing of
With ws1.Range("i : i") '**this is the line i have issues with**
Set d = .Find(fNote, LookIn:=xlValues) 'when fnote is found in Row "i"
d.ClearContents 'delete it
End With
with
With ws1.Range(i & ":" & i) 'the string range must be built from the variable concatenated with ":"...
Set d = .Find(fNote, LookIn:=xlValues)
d.ClearContents 'clears its contents
End With
or even simpler, with:
With ws1.Rows(i)
Set d = .Find(fNote, LookIn:=xlValues)
d.ClearContents 'clears its contents
End With

VBA: How to improve code with for and if loops

Looking for the best way to write the following code. I am currently struggling to make my code as simple and neat as possible. The code effectively takes a range and returns back the range which is non-empty.
Option Explicit
Sub ReturnNonEmptyRange()
Dim testBool As Boolean
Dim i As Long
testBool = True
For i = 2 To 10000:
If Range("G" & i) = "" Then
i = i - 1
testBool = False
End If
If testBool = False Then
Exit For
End If
Next i
MsgBox ("The range is G2:K" & i)
End Sub
Below is some sample code you can try.
The function LastUsedRow is not used, but I'm providing since it can be useful. This will return the last used row in your worksheet.
Using "Range" like you did above will assume you want to use active sheet. I always like to specify a workbook and a sheet so there is no ambiguity.
Sub Test()
' Start at row 1 and and stop when first blank cell found
Dim wks As Worksheet: Set wks = ThisWorkbook.Worksheets("Sheet1")
Dim row As Long
' Option 1: using column numbers
row = 1
Dim col As Long: col = 7 ' G
Do Until wks.Cells(row + 1, col).Value = ""
row = row + 1
Loop
MsgBox ("Last used row (in column): " & row) ' assumes something in row 1
' Option 2: using column letters
row = 1
Dim colLetter As String: colLetter = "G"
Do Until wks.Range(colLetter & row + 1).Value = ""
row = row + 1
Loop
MsgBox ("Last used row (in column): " & row) ' assumes something in row 1
End Sub
Public Function LastUsedRow(wks As Worksheet) As Long
Dim rng As Range: Set rng = wks.UsedRange ' Excel will recalc used range
LastUsedRow = rng.row + rng.Rows.Count - 1
End Function
I think your method only works if your none-empty range is consecutive. Suppose G2:G10 is non-empty, G11 is empty and G12:G20 is non-empty. Your code would come to i=11 and return G2:K10 as the non-empty range.
A more reliable, and quicker way to find the last non-empty cell (before row 1000) would be this:
range("G1000").End(xlUp).row
This will give you the first non-empty row in column G above row 1000. If row 1000 is non-empty however, it would search upwards for the last non-empty row. so you might want to change it to:
Range("G" & Rows.Count).End(xlUp).Row
This will find the last non-empty row, starting from the bottom of the worksheet.
How about combining the loop's exit conditions all into the loop control header.
I also would explicitly access the range()'s value to be more clear in the code and check the string length to be zero.
Option Explicit
Sub ReturnNonEmptyRange()
Dim testBool As Boolean
Dim i As Long
testBool = True
i = 2
While (i < 10000) And (Len(Range("G" & i).Value) <> 0)
i = i + 1
Wend
MsgBox ("The range is G2:K" & i)
End Sub
In the case this was an Array, one could not use Range("G" & Rows.Count).End(xlUp).Row. I believe #Siddharth provided a good solution. The downside being it will stop at a non- empty row.
Sub ReturnNonEmptyRange()
Dim i As Long
For i = 2 To 10000:
If Len(Trim(Range("G" & i).Value)) = 0 Then Exit For
Next i
MsgBox ("The range is G2:K" & i - 1)
End Sub

VBA Copy and Paste

So I have a VBA that is suppose to copy the on the "data" sheet and paste it on the "Internal Use" via searching a cell on cell in the "Internal Use" I'm not getting an error it is just not doing it and it after I run the macro it just stays on the "data" sheet.
What am I missing?
Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If
Next Row
End Sub
Hard to tell what you're trying to do. Let me know if this is what you want.
Sub CommandButton2_Click()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim nr As Long
Dim project As Variant
Set ws1 = ThisWorkbook.WorkSheets("Internal Use")
Set ws2 = ThisWorkbook.WorkSheets("data")
project = ws1.Range("C4").Value2
With ws1
nr = .Range("A" & .Rows.Count).End(xlUp).Row
For r = 2 To nr
If .Range("F" & r) = project Then
ws2.Range("Q" & r) = .Range("C7")
End If
Next
End With
End Sub
Ricardo,
Your code is working fine. Question is what are you trying to accomplish? If you are trying to paste on 'Internal Use' sheet, you need to activate it. I have added a line to activate it. Please be more specific on what you want to accomplish.
Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Internal Use").Activate
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If
Next Row
End Sub
You want to populate column Q on the data sheet with the value from Worksheet Internal Use cell C7, whenever column F on the same row is equal to cell C4.
I have to say that that's easily solvable with a formula using index match or a conditional formula like =If(F2='Internal Use'!$C$4,'Internal Use'!$C$7,"") (Just paste in column F). At least this is what your code currently more or less does or seems to want to achieve.
That said let's take a look at your code:
First of all avoid .Activate, it's unnecessary overhead. This will activate the worksheet. (By the way, the last .activate you use, is on the data worksheet, hence it stays there) Next you store C4 in an undeclared variable called project that you never use.
Next you reference the cells everywhere in the loop again. This means there is huge overhead on accessing and reading out these cells. Lastly you do this in a loop; I assume this is to avoid filling up any of the other rows.
To make your code work, you could use:
Sub CommandButton2_Click()
Dim project as string
Dim writeValue as string
Dim lr as long
Dim wr as long
project = Worksheets("Internal Use").Range("C4").value
writeValue = Worksheets("data").Range("C7").value
lr = Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("data")
For wr = 2 To lr
If .Range("F" & wr).value = project Then
.Range("Q" & rw).value = writeValue
End If
Next wr
End With
End Sub
This will do the trick.
Neater would be to avoid the for loop and testing all cells. Two options are putting the entire F and Q columns into arrays and loop through those simultaniously while altering the Q-array before dumping the values back in the sheet, or use a Find-algorithm such as Chip Pearons FindAll: http://www.cpearson.com/excel/findall.aspx

Hide rows according to range of cells

Good day, I would love to ask you a question.
I have two colls with numbers and I need to compare first coll (longer) with second coll (shorter) and if there is a match, hide the row where the match occurs.
I have this so far:
Sub RowHide()
Dim cell As Range
Dim CompareCells As Range
Set CompareCells = Range("I2:I18")
For Each cell In Range("A2:A200")
If cell.Value = CompareCells Then
cell.EntireRow.Hidden = True
End If
Next
End Sub
My problem is that I don't know how to set value of CompareCells to start comparing. I'll appreciate every advice.
You have to set 2 separate ranges and compare them. If you want every cell compared with the one on the same line (A1 with B1, A2 with B2, etc) then consider using:
for i = 1 to something
set cell1 = range("A" & i)
set cell2 = range("B" & i)
if cell1.value = cell2.value then
'Do this, and do that!
cell1.entirerow.hidden = true
end if
next i
try this:
Sub RowHide()
Dim Longer As Range
Dim i As Double
i = 2 'Initial row
For Each Longer In Range("A2:A200")
If Longer.Value = Cells(i,2).Value Then
Longer.EntireRow.Hidden = True
End If
i = i + 1
Next
End Sub
PS:
Cells(RowIndex, ColumnIndex).Value: returns the value of the Row And Column.
ColumnIndex => Column A = 1, Column B = 2, an so on...
I looked into both of yours ideas and converted them into one and I finally get it working.
Here is my final code:
Sub RowHide()
Dim i As Integer
Dim j As Integer
For i = 2 To 197
Set FirstRange = Range("A" & i)
For j = 2 To 18
If FirstRange.Value = Cells(j, 8).Value Then
FirstRange.EntireRow.Hidden = True
End If
Next j
Next i
End Sub
Only modification if someone wants to use it is that you have to change numbers in for cycles according to number of rows in columns.
Thanks to both of you for your advices.

Offset function for Dynamic Chart causing problems with blank cells

I am using the OFFSET Function to create a dynamic chart for the table depicted in the image below. Basically on the click of the button labeled "Copy Mean VCD Values" the code copies values from another sheet to the current sheet. If it encounters any cells with "#DIV/0!" I have it set to put "N/A" instead. But in this case I don't get a dynamic chart. If in stead of N/A I do "" it creates a dynamic chart but adds junk values "1" to the first set on the graph. I only get the desired results if I manually delete all the rows containing "N/A" below the last row containing data (See image for details).
https://lh6.googleusercontent.com/-OfjK6dSRQE8/U2JkdadjedI/AAAAAAAAABk/d8WDLuuC7Lk/w1068-h803-no/Offset+error.PNG
This is the code I am using for the Command Button "Copy Mean VCD Values":
Private Sub CommandButton2_Click()
r = 7
'//j increments the column number
'//i increments the row number
'//r is used for taking values from alternate cells(sheet3 column K) rowwise
For j = 2 To 14
For i = 7 To 26
If ThisWorkbook.Sheets(3).Range("K" & r & "").Text = "#DIV/0!" Then
ThisWorkbook.Sheets(2).Cells(i, j).Value = "N/A"
Else
ThisWorkbook.Sheets(2).Cells(i, j).Value = ThisWorkbook.Sheets(3).Range("K" & r & "").Value
End If
r = r + 2
Next i
Next j
End Sub
If I add the following code it works but it deletes the entire rows before and after the table. See image : https://lh6.googleusercontent.com/-WiM8HN61zkM/U2Jz2J_JxjI/AAAAAAAAACw/z4i3hlakyAI/w1598-h442-no/offset+delete+row.PNG
Private Sub CommandButton2_Click()
r = 7
'//j increments the column number
'//i increments the row number
'//r is used for taking values from alternate cells(sheet3 column K) rowwise
For j = 2 To 14
For i = 7 To 26
If ThisWorkbook.Sheets(3).Range("K" & r & "").Text = "#DIV/0!" Then
ThisWorkbook.Sheets(2).Cells(i, j).Value = "N/A"
Else
ThisWorkbook.Sheets(2).Cells(i, j).Value = ThisWorkbook.Sheets(3).Range("K" & r & "").Value
End If
r = r + 2
Next i
Next j
Dim c As Range
Dim SrchRng
Set SrchRng = ActiveSheet.Range("B7:B26")
Do
Set c = SrchRng.Find("N/A", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Value = ""
Loop While Not c Is Nothing
End Sub
And this is OFFSET Function I am using for Column B in this case:
=OFFSET('Data Summary Template'!$B$7,0,0, COUNTA('Data Summary Template'!$B$7:$B$26),1)
I can't exactly replicate this problem you're having... I think the initial problem must have something to do with the warning regarding invalid references. You should look in to that and figure out the cause, which is probably the cause of "extra" data in your chart.
If deleting the N/A values appears to be working, try something. Instead of:
Set SrchRng = ActiveSheet.Range("B7:B26")
Do
Set c = SrchRng.Find("N/A", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Value = ""
Loop While Not c Is Nothing
Do this:
Dim tblCell as Range
Dim tbl as ListObject
Set tbl = ActiveSheet.ListObjects(1)
For each tblCell in tbl.DataBodyRange.Columns(2).Cells
If tblCell.Value = "N/A" Then
tblCell.Resize(1, tbl.DataBodyRange.Columns.Count - 1).Value = vbNullString
End If
Next

Resources