I am trying to create a code that will search for a given column header and copy the contents of the column after first replacing all the blanks with a zero.
I have tried using the following code, but the second parameter for the range function at the bottom does not work when I try to use "lastrow".
lastrow is defined by the numeric last row value, but I cant seem to figure out how to combine that with the alphabetical reference that is given in dbt.address
`Sub replacezeros()
Dim dbt As Range
Dim lastrow As Range
'This is to define last row of array
Set lastrow = Range("A" & Rows.Count).End(xlUp)
Debug.Print lastrow.Row
'This is for Debit
Set dbt = Range("A1:J1").Find("Debit")
Debug.Print dbt.Address
Debug.Print dbt.Cells
'Range(dbt.Address,).SpecialCells(xlCellTypeBlanks) = 0
End Sub`
Hoping to get this to replace all zeros only in that one column that is searched to select "Debit"
Not sure if I've understood your problem - try this:
Sub replacezeros()
Dim dbt As Range
Dim lastrow As Range
'This is to define last row of array
Set lastrow = Range("A" & Rows.Count).End(xlUp)
Debug.Print lastrow.Row
'This is for Debit
Set dbt = Range("A1:J1").Find("Debit")
If Not dbt Is Nothing Then 'avoid error if Debit not found
On Error Resume Next 'avoid error if no blanks
Range(dbt.Offset(1), Cells(lastrow.Row, dbt.Column)).SpecialCells(xlCellTypeBlanks).Value = 0
On Error GoTo 0
End If
End Sub
Something like this should work... (untested though)
Sub replacezeros()
Dim dbt As Range, rData As Range, Cell As Range
Dim lastrow As Long: lastrow = Range("A" & Rows.Count).End(xlUp).Row
'This is for Debit
Set dbt = Range("A1:J1").Find("Debit")
If Not dbt Is Nothing Then
Set rData = Range(Cells(1,dbt.Column),Cells(lastrow, dbt.Column))
For Each Cell In rData.SpecialCells(xlCellTypeBlanks)
Cell.Value = 0
Next Cell
End If
End Sub
Related
I have a worksheet named "garcat_nv" with hundreds of columns. The first row contains the names that I'd like to give to each column. How can I loop through my sheet to give each column the name given in the first cell of that column ? This is an example of the Column AJ that I'd like to name GCFRRE.
Dim GCFRRE As Range
LastRow = garcat_nv.Cells(Rows.Count, 1).End(xlUp).Row
Set GCFRRE = Range("AJ2:AJ" & LastRow)
garcat_nv.Names.Add Name:="GCFRRE", RefersTo:=GCFREE
I attempted this loop:
Dim i As Long
Dim rng As Range
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To nbr_col Step 1
Set rng = Range("i2:i" & LastRow)
.Names.Add Name:=.Cells(1, i).Value, RefersTo:=rng
Next i
I get a 1004 error. How can this be solved ? Thanks.
The RefersTo parameter should be a string rather than a range - the string being the address of the range. Sample code might look something like this (but you might want to stick to your lastRow method rather than UsedRange):
Dim col As Range
For Each col In Sheet1.UsedRange.Columns
With Sheet1.Names 'or ThisWorkbook.Names for global scope.
'Remove any existing name.
On Error Resume Next
.Item(CStr(col.Cells(1))).Delete
On Error GoTo 0
'Add the new name.
.Add _
Name:=col.Cells(1).Value, _
RefersToR1C1:="=" & col.Address(ReferenceStyle:=xlR1C1)
End With
Next
I've already used Set to create ranges with names in the format rng1a. I then use a loop to go through i (integer) values, and want to set the final range to use to be the one that has the name in the form 'rng' & i & "a"
My initial thought was something along the lines of Range("rng" & i & "a"), however this results in an error.
Set rng1a = Range("B2", Range("B2").End(xlDown))
Set rng2a = Range("D2", Range("E2").End(xlDown))
i = 1
Do
("rng" & i & "a").Copy 'this is the problem
Range("A2").End(xlDown).Offset(1,0).PasteSpecial xlPasteValues
i = i + 1
Loop Until i = 3
I keep getting an error message with
run-time error '1004':
Method 'Range' of object '_Global' failed
My thought is that I need to format the name of the range as a string so that it can be recognised as the name of a range. Is there a way to do this?
I haven't tested either of these, but I think they should work.
Be wary of using End(xldown) as if you don't have anything underneath the first cell you will go straight to the very last cell. Better to work up from the bottom (see Damian's answer).
Sub x1()
'Array
Dim rng(1 To 2) As Range, i As Long
Set rng(1) = Range("B2", Range("B2").End(xlDown))
Set rng(2) = Range("D2", Range("E2").End(xlDown))
For i = 1 To 2
rng(i).Copy
Range("A2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Next i
End Sub
Sub x2()
'Named ranges
Dim i As Long
Range("B2", Range("B2").End(xlDown)).Name = "rng1a"
Range("D2", Range("E2").End(xlDown)).Name = "rng2a"
For i = 1 To 2
Range("rng" & i & "a").Copy
Range("A2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Next i
End Sub
This should do it:
Option Explicit
Sub Test()
Dim i As Long, LastRow As Long
Dim arrRanges(1 To 2) As Range
With ThisWorkbook.Sheets("NameYourSheet") 'change the sheet name
Set arrRanges(1) = .Range("B2", .Range("B2").End(xlDown))
Set arrRanges(2) = .Range("D2", .Range("E2").End(xlDown))
For i = LBound(arrRanges) To UBound(arrRanges)
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
arrRanges(i).Copy .Range("A" & LastRow)
Next i
End With
End Sub
Remember to always declare all your variables, and reference to workbooks and worksheets.
What you actually want to do (I think) is copy the contents of the columns B,C D etc, into Column A underneath each other.
Sub CopyStuff
Dim i as integer
dim r as range
for i = 1 to 6
set r = range(cells(1,i),cells(1,i).end(xldown))
r.copy
range("a1").end(xldown).offset(1,0).pastespecial xlpastevalues
next i
End sub
You can have array of ranges :
Set rng1a = Range("B2", Range("B2").End(xlDown))
Set rng2a = Range("D2", Range("E2").End(xlDown))
For Each rng in Array(rng1a, rng2a)
rng.Copy
Range("A2").End(xlDown).Offset(1,0).PasteSpecial xlPasteValues
Next
UPDATE:
Data set is made of strings that are number though (I don't get it) -> I can do all the math stuff with them as with regular numbers.
Problem is I need to separate cells that look like this "186.85" and cells that look like this "1.76 Dividend".
====================
I need a loop to check row by row if the cell contains some text (word "dividend" specifically) or if it's just number. If it is a text, then delete it and move to the next row.
It does some deleting BUT it wipes like 50 rows of data almost every time (I have only two text populated rows in this particular data set). These rows are numbers.
Dim i As Long
i = 2
Do
If WorksheetFunction.IsText(Sheets("Data").Cells(i, 5)) = True Then
If Not Worksheets("Data").Cells(i, 5).Value = "" Then
Worksheets("Data").Rows(i).Delete
End If
End If
i = i + 1
Loop Until i = 100
I expected to loop through the data and delete the entire row if a cell contains text.
This code so far deletes things kinda randomly.
The below has been updated to a dynamic range. This will not need modification regardless of how many rows your sheet has.
More importantly, deleting rows inside a loop will cause your range to shift at every deletion. The way around this is to loop backwards
OR, even better..
Don't delete cells inside your loop. Every time your criteria is met, you force an action (deletion). Instead, gather up all of the cells to be deleted inside your loop and then delete the entire collection (Union) all at once outside of the loop. This requires 1 action in total rather 1 action per text instance
Sub Looper()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update sheet name
Dim i As Long, LR As Long
Dim DeleteMe As Range
LR = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
For i = 2 To LR
If WorksheetFunction.IsText((ws.Range("E" & i))) Then
If Not DeleteMe Is Nothing Then
Set DeleteMe = Union(DeleteMe, ws.Range("E" & i))
Else
Set DeleteMe = ws.Range("E" & i)
End If
End If
Next i
If Not DeleteMe Is Nothing Then DeleteMe.EntireRow.Delete
End Sub
Try something like this:
Sub test()
Dim i As Long
For i = 100 To 2 Step -1
With ThisWorkbook.Worksheets("Data")
If WorksheetFunction.IsText(.Cells(i, 5)) = True Then
If Not .Cells(i, 5).Value = "" Then
.Rows(i).EntireRow.Delete
End If
End If
End With
Next i
End Sub
You can use SpecialCells with xlCellTypeConstants-2... No need for a loop. See Range.SpecialCells method (Excel) and XlSpecialCellsValue enumeration (Excel)
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
On Error Resume Next
Set rng = .Columns(5).SpecialCells(xlCellTypeConstants, 2)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With
End Sub
Thank you all for quick responses and effort.
I managed to get this solution working with InStr() function:
''loop through the Data and remove all rows containing text (Dividend payments which we don't need)
Dim i As Long
Dim ws As Worksheet
Dim searchText As String
Dim searchString As String
i = 2
Set ws = Sheets("Data")
Do Until ws.Cells(i, 2).Value = ""
searchText = "Dividend"
searchString = ws.Cells(i, 2).Value
If InStr(searchString, searchText) Then
ws.Rows(i).Delete
End If
i = i + 1
Loop
I'm learning VBA in Excel 2013 and I posted a question last weekend but didn't receive a response. I've been working on the code more and narrowed the error down to one. I'm trying to highlight a row in a workbook if a value in column A is found in the column A another open workbook.
I get a Runtime error 13: Type mismatch error. That is all that it says and it is for this line of code:
If cell.Value = valuetofind Then
I have looked on numerous sites about this error but I don't see any that match my situation. I think it's b/c 'valuetofind' is a range and it's trying to set a range equal to a value, seen in 'cell.value'. I think all of my variables are declared properly.
I've tried changing it to below so that they are both ranges but that gives the same error:
If cell = valuetofind Then...
Can anyone help with this error?
Sub HighlightRow()
'http://www.vbaexpress.com/forum/showthread.php?26162-Solved-Highlight-ROW-based-on-cell-value
'http://www.mrexcel.com/forum/excel-questions/827262-visual-basic-applications-vlookup-between-2-workbooks.html
'test column just picks any column, I think, to test how far down the rows go to, I think you could choose any column
Const TEST_COLUMN As String = "D" '<=== change to suit
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LastRow As Long
Dim cell As Range
Dim valuetofind As Range
Set ws1 = ThisWorkbook.Sheets(1) 'name will change each day
Set ws2 = ActiveWorkbook.Sheets(1) 'name will change each day
With ws1
LastRow = Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
'LastRow is testing/finding out last row using TEST_COLUMN first before performs rest of macro
End With
Set valuetofind = ws2.Range("A2:A" & LastRow)
'Range("A2:A" & LastRow) is the criteria row where it is looking for Break Down and PM/SM Call below
'Resize(,7) will highlight the row however many columns you tell it to, in this case 7
'cell.Offset(, -6) I think tells to go back 6 columns to column A and start the highlighting there
With ws1
For Each cell In Range("A2:A" & LastRow)
If cell.Value = valuetofind Then
'old, do not use: wb2.Worksheets(wb2SheetName).Range("A2:A" & LastRow)
cell.Offset(, -6).Resize(, 7).Interior.ColorIndex = 39
Else
cell.EntireRow.Interior.ColorIndex = xlNone
End If
Next
End With
End Sub
The code has been altered and is working for anyone who needs help.
This is modified from Dinesh Takyar's video on copying data between worksheets(https://www.youtube.com/watch?v=AzhQ5KiNybk_), though this code below is to highlight rows between workbooks. Both workbooks, destination and source workbooks, need to be open.
I believe the original Run Time 13 Error was b/c the criteria, original variable called 'valuetofind' was Dim as Range, when it is a String. The variable in the code below is now called 'myname' and is Dim as String. But I don't believe the code above would have worked anyway b/c I needed the For/Next to go through each cell in my criteria column.
Thanks to Dinesh and people on this forum.
Sub HighlightRowBtwWorkbook()
Dim wkbkDest As Workbook
Dim i As Long
Dim lastrowDest As Long
Dim lastcolDest As Long
Dim wkbkSource As Workbook
Dim j As Long
Dim lastrowSource As Long
Dim myname As String
Dim lastcolSource As Long
'Destination
Set wkbkDest = ThisWorkbook 'was Workbooks("Destination_VBAHighlight.xlsm") 'was ActiveWorkbook
lastrowDest = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lastcolDest = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastrowDest
myname = wkbkDest.ActiveSheet.Cells(i, "A").Value
'Source
Set wkbkSource = Workbooks("TESTVBA.xlsm")
wkbkSource.Activate
lastrowSource = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lastcolSource = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For j = 2 To lastrowSource
If ActiveSheet.Cells(j, "A").Value = myname Then
'Activate Destination
wkbkDest.Sheets(1).Activate
ActiveSheet.Range(Cells(i, "B"), Cells(i, lastcolDest)).Interior.Color = RGB(252, 228, 214)
End If
Next j
Next i
'select cell A1 in Destination wkbk to end there
wkbkDest.Sheets(1).Activate
wkbkDest.ActiveSheet.Range("A1").Select
End Sub
I'm trying to make a program in the Excel VBA that inserts a formula into a column of cells. This formula changes based on the contents of the cell directly to the left.
This is the code I have written so far:
Sub Formula()
Dim colvar As Integer
colvar = 1
Dim Name As String
Name = "Sample, J."
Do While colvar <= 26
colvar = colvar + 1
Name = Range("B" & colvar).Value
Range("C" & colvar).Value = "='" & Name & "'!N18"
Loop
End Sub
As you can see, I want to insert the variable Name between the formula strings, but Excel refuses to run the code, giving me a "application-defined or object-defined error."
Is there a way to fix this?
You will need some error checking in case the sheets don't actually exist in the workbook.
it looks like you are looping through column B that has a list of sheet names and want range N18 to display next to it.
Something like
Sub Button1_Click()
Dim Lstrw As Long, rng As Range, c As Range
Dim Name As String
Lstrw = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B1:B" & Lstrw)
For Each c In rng.Cells
Name = c
c.Offset(, 1) = "='" & Name & "'!N18"
Next c
End Sub
Or you can just list the sheets and show N18 next to it, run this code in a Sheet named "Sheet1"
Sub GetTheSh()
Dim sh As Worksheet, ws As Worksheet
Set ws = Sheets("Sheet1")
For Each sh In Sheets
If sh.Name <> ws.Name Then
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1) = sh.Name
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(0, 1) = sh.Range("N18")
End If
Next sh
End Sub
Thank you to everyone for your help! I actually found that I had just made a silly error: the line Do While colvar<=26 should have been Do While colvar<26. The cells were being filled, but the error manifested because one cell was being filled by a nonexistent object.
I did decide to use the .Formula modifier rather than .Value. Thank you to Jeeped for suggesting that.