VBA Code replacing values in column D if cell in column c - excel

I am new to VBA and i tried to create i sub that will update (with vlookup and then copy paste) the comments with new comments from another sheet depending on the case status ("Open"). Basically i tried to put together a code that inserts new rows at the end of the table with a vlookup macro.
The main problem is that i do not know how to instruct excel to identify in which cell he should do the lookup and then copy and paste. As in the example below "M528" will not do it as i want to keep the records that are closed as well. I receive daily only the open cases so therefore i don`t want the code to do any vlookups in those cells where the status is "Closed"
Sub ChangesUpdates()
lastRow = Worksheets("CurrentDash").Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lastRow
If Worksheets("CurrentDash").Range("AS" & r).Value = "Open" Then
Range("M528").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=VLOOKUP([#[Parent Case Number]],NewData!C[-12]:C,13,0)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Without changing things too much, you can do most of what you want with
Sub ChangesUpdates()
lastRow = Worksheets("CurrentDash").Range("A" & Rows.Count).End(xlUp).Row
For rw = 2 To lastRow
If Worksheets("CurrentDash").Range("AS" & rw).Value = "Open" Then
With Worksheets("CurrentDash").Range("M" & rw)
.FormulaR1C1 = "=VLOOKUP([#[Parent Case Number]],NewData!C[-12]:C,13,0)"
.Value = .Value ' effectively a paste-values
End With
End If
Next rw
End Sub
There's no cell selection/activation here so the screen won't move to the updates, but it should cycle through the same set as your routine.
There's some remaining question in my mind about how stable the lookup area is, which you should think about.

Related

VBA Macro help, Inserting Row and Paste Special Formula

All,
I would greatly appreciate if someone could assist me with my VBA code Macro. I have 2 different Macros and I need to combine them AND alter one.
Im inserting a row via Excel at the bottom of the Table ABOVE my "Total Row". That works fine!!!
Sub InsertingRow()
Range("A" & Rows.Count).End(xlUp).Select
ActiveCell.EntireRow.Insert
End Sub
Then:
Sub Macro1()
'
' Macro1 Macro
'
'
Range("F12:O12").Select
Selection.Copy
Range("F13").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
**I need to combine the 2 Macros, but I need the PasteSpecial Macro to increment down with the Insert Row Macro and keep the specific columns/cells its copying too as well.
I have a "Total Row" so I need it to push the Total row down and insert/copy in the one above it.
Im sure this is easy.**
Thanks for all the replies.
Something like this should get you on the right track. I am not sure where your data needs to be copied from but give this a try and you will see how it works.
Sub Test()
Dim lastRow As Integer
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Rows(lastRow).Insert
Range("F" & lastRow - 1 & ":O" & lastRow - 1).Copy
Range("F" & lastRow).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

concatenate cell contents with VBA

the original dataset in Excel look like this:
But I want to transpose for example the cells A3:A4 to B4:C4. In Excel I only need to copy the cells and then right click in cell B4 and click on transpose the copy cell. But due to 100k rows, I need to find a good solution how to do that.
One problem is that between the cell, I have text contents like "first section", "second section", "third section", and I don't want to transpose it.
Means for the first section, it should only consider A3 and A4 and so on.
Here is the picture, how I it should be looks like.
[2
I record the macro, but I don't know where I should tell them with "IF-Clause" that it should only consider everything except the yellow cells.
Sub transponieren()
'
' transponieren Makro
'
'
Range("A3:A4").Select
Selection.Copy
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub
The 'test' you're probably looking for is the IsNumeric() test. The following code suggestion assumes your data is on Sheet1, and the numbers are actually numbers and not text. There's probably a more elegant solution, but this does work:
Sub transposeNumbers()
Dim c As Range, LastRow As Long, TopN As Long, LastN As Long
LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For Each c In Sheet1.Range("A3:A" & LastRow)
If IsNumeric(c.Offset(-1, 0)) = False Then
TopN = c.Row
Else
If IsNumeric(c.Offset(1, 0)) = False Or c.Row = LastRow Then
LastN = c.Row
Sheet1.Range(Sheet1.Cells(TopN, 1), Sheet1.Cells(LastN, 1)).Copy
c.Offset(0, 1).PasteSpecial Paste:=xlPasteAll, transpose:=True
Application.CutCopyMode = False
End If
End If
Next c
End Sub

Copy range and transpose paste into row that contains cell

I have a mix of codes I found that seemed to work but no longer does after changing a few things. I am trying to copy values from a range on one sheet ("Sheet1") and paste them transposed onto another ("Sheet2"). The catch is that I only want to paste them into the row that the value in column A equals the value in ("B2") on the same sheet. Also, this value will be repeated throughout column A, but I only need it to paste to the row between rows 11 and 29. Here is what I have so far:
Sub PasteData()
Range("O3:O44").Select
Selection.copy
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Unprotect ("Password")
Dim nRow As Long
Dim nStart As Long, nEnd As Long
For nRow = 11 To 29
If Range("A" & nRow).Value = Range("b2").Value Then
nStart = nRow
Exit For
End If
Next nRow
For nRow = nStart To 29
If Range("a" & nRow).Value <> Range("b2").Value Then
nEnd = nRow
Exit For
End If
Next nRow
nEnd = nEnd - 1
Range("A" & nStart & ":AP" & nEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Worksheets("Sheet2").Protect Password:="Password", DrawingObjects:=True, Contents:=True, Scenarios:=False
Worksheets("Sheet3").Activate
Range("B13").Select
End Sub
I have noticed on your code that you have not referenced the sheet of Range("O3:O44"). So when you run the code, it will Select and Copy the Range("O3:O44")of the active sheet.
To avoid this confusion, avoid using .Select and .Activate as much as possible especially when dealing with multiple sheets. When referencing Ranges, always include the sheet you are targeting to.
So instead of:
Range("O3:O44").Select
Selection.Copy
Do it like this:
Worksheets("Sheet1").Range("O3:O44").Copy
Now to answer your problem, you need to indicate what sheet Range("O3:O44") is from.
Then move this code on the line just before pasting it.
'range to copy with sheet reference
Worksheets("Sheet1").Range("O3:O44").Copy
'range where previous range will be pasted, also with sheet reference
Worksheets("Sheet2").Range("A" & nStart & ":AP" & nEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Upon trying your code, this is the solution to the error you encounter.

Excel VBA Select Range based on variable

I have a piece of VBA code that is taking data from a spread sheet and formatting it into an input file. This code loops through each column header to makes sure it can find the column its looking for and then offsets by one to get off of the header row and then copies the data to another template.
However this sheet is used by multiple users and the amount of rows being populated can vary so I have set up a variable called rowcount. In this example I'm working on I have 5 records and so I'm trying to select the range from the active cell to the rowcount value (5) but I'm just stuck on the following line:
ActiveSheet.Range(ActiveCell, RowCount).Select
Below is the full code for this section, I know what I'm doing is wrong but any searching via Google throws up results that are too specific and I can't tweak the code to work for me.
If ActiveCell.Value = "Account Name" Then
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
ActiveSheet.Range(ActiveCell, RowCount).Select
Selection.Copy
Sheets("Input").Activate
ActiveSheet.Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheets("Account Details").Select
End If
End If
For someone with more VBA knowledge I'm sure its easy but I'm essentially trying to get highlight Activecell and down to the variable so in this case A5:A10, copy, then paste.
Thanks in advance
Using Select, Activate and ActiveCell is not considered a good practice in VBA. See How to avoid using Select in Excel VBA
However, it takes time to learn to avoid these. Thus, in your code change this line:
ActiveSheet.Range(ActiveCell, RowCount).Select
To this one:
ActiveSheet.Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column)).Select
And if you have rowCount declared and set correctly, then this is a possible option:
Dim rowCount As Long: rowCount = 5
ActiveSheet.Range(ActiveCell.Column, rowCount).Select
First yours,
If ActiveCell.Value = "Account Name" Then
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
ActiveCell.RESIZE(RowCount, 1).Select '<~~ resize to the # of rows
Selection.Copy
Sheets("Input").Activate
ActiveSheet.Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheets("Account Details").Select
End If
End If
Now without Select, Activate or ActiveCell
dim c as variant
with worksheets("sheet1") 'you should know what worksheet you are starting out on
c = application.match("Account Name", .rows(4), 0)
if not iserror(c) then
if .cells(5, c).Value <> "" then
workSheets("Input").Range("C2").resize(RowCount, 1) = _
.cells(5, c).resize(RowCount, 1).value
end if
end if
end with
How to avoid using Select in Excel VBA
Or just use:
ActiveCell.Resize(RowCount,1).Select
Where 1 is number of columns.
At the moment in your range you have just the activecell and row number.
Try something like this:
ActiveSheet.Range(activecell.address &":" &cells(RowCount,ActiveCell.Column).address).select
Don't select the range to copy it; implementing something like this should do the job for you:
Sub Test()
Dim RNG As Range
If ActiveCell.Value = "Account Name" Then
With ActiveSheet
Set RNG = .Range(.Cells(ActiveCell.Row + 1, ActiveCell.Column), ActiveSheet.Cells(.Cells(ActiveSheet.Rows.Count, ActiveCell.Column).End(xlUp).Row, ActiveCell.Column))
End With
RNG.Copy Sheets("Input").Range("C2")
End If
End Sub

Conditional based copy cells to another sheet cancelled

I am trying to write macro to copy cells (condition based) from one sheet to another sheet.
When I am running the macro, I got "pasteSpecial method of Range class failed" error.
I tried to solve it. But I could not able to do it.
Sub update_tuning()
Dim tun_num, tun_select, source1, target1 As Range
Dim r, lr As Long
Sheets("Calc").Select
Set tun_num = Range("B2")
If tun_num <> Null Then
Sheets("Calc").Select
Range("C22:BE22").Select
Selection.Copy
End If
Sheets("DATA_Lbf_ft").Select
lr = Sheets("DATA_Lbf_ft").Range("B3:B1803").Count
For r = 3 To lr
If Range("B" & r).Value = tun_num Then
Exit For
End If
Next r
Sheets("DATA_Lbf_ft").Range("B" & r).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Please give your comments to solve it.
There are too many operations between your .Copy and .PasteSpecial. The .CutCopyMode (when you would normally see the blinking border around the copied cell(s) on the worksheet) is cancelled by the other operations.
It would be better to copy and paste after you have made the destination determination.
For r = 3 To lr
If Range("B" & r).Value = tun_num Then
Exit For
End If
Next r
Sheets("Calc").Range("C22:BE22").copy _
destination:=Sheets("DATA_Lbf_ft").Range("B" & r)
If you abandon the original copy operation and use this method, I believe you should get the results you are looking for.
Addendum:
For value only transfer substitute the following for the .Copy Destination:= ... operation.
With Sheets("Calc").Range("C22:BE22")
Sheets("DATA_Lbf_ft").Range("B" & r).Resize(.Rows.Count, .Columns.Count) = .Cells.Value
End With

Resources