I have a table with 2 columns.
A B
A2 B2 nn
A3 B3 nn
.....
An Bn nn
I need to copy the content of B2 cell and paste it to all the other B column cells, where A column has a value.
Then to find a certain value (nn) in B column and substitute it with A column value.
In order to copy B2 content I do this:
Sub CopyTest()
'ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
Range("B3:B1048576").Select
Selection.ClearContents
Range("B2").Copy
Range("B2:B7").PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End Sub
1.The problem is that I don't know how to do a paste not till certain cell (B7), but for all the table (so till A column contains value).
Similar problem I have substituting certain B column value with a value from column A.
Sub ReplaceExample()
Dim OriginalText As String
Dim CorrectedText As String
OriginalText = Range("B2").Value
CorrectedText = Replace(OriginalText, "E_ONBAL", Range("A2").Value)
Range("B2").Offset(, 1).Value = CorrectedText
End Sub
2.How to do the same action for all the A column, so to do kind of loop?
Thanks!
The first part is managed, so I publish the answer, in case it will be useful for someone:
Sub CopyTest()
Range("B3:B1048576").Select
Selection.ClearContents
Set currentsheet = ThisWorkbook.Worksheets("Sheet1")
LastRow = currentsheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range("B2").Copy
Range("B3" & ":" & "B" & LastRow).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End Sub
I just still did not manage how to modify second part of the script with substitution in order to do the same action for all the A column, so to do kind of loop.
This example how to copy from activesheet to another sheet.
Sub Test1()
Dim SuccessSheet As String
Application.ScreenUpdating = False
SuccessSheet = ActiveSheet.Name
WS_Count = ActiveWorkbook.Worksheets.Count
' Generate new sheet if it does not exist
If Not sheetExists(SuccessSheet & " Log") Then
Set WS = Sheets.Add(After:=Worksheets(WS_Count))
Worksheets(SuccessSheet).Columns(2).Copy Destination:=Worksheets(WS.Name).Columns(2)
Worksheets(SuccessSheet).Columns(4).Copy Destination:=Worksheets(WS.Name).Columns(1)
WS.Name = SuccessSheet & " Log"
End if
Application.ScreenUpdating = True
End Sub
Related
I'm new to VBA and not very adept with the programming so I'm hoping for some help here.
Here's the thing:
I have an excel sheet where I need to scan the entire rows and delete rows where Column C and Column D have the text "NA" in the same row.
Thanks in advance.
Here is something I've used before. This applies filters, filters for NA in both column C and D, then removes those rows (excluding the header). Note that this will only remove the row if NA is in BOTH columns. If NA is in C but not in D then it will not remove the row.
'Applies filter to the columns. You will want to adjust your range.
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$D$6").AutoFilter Field:=3, Criteria1:="NA"
ActiveSheet.Range("$A$1:$D$6").AutoFilter Field:=4, Criteria1:="NA"
'Removes the rows that are displayed, except the header
Application.DisplayAlerts = False
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
Application.DisplayAlerts = True
'Removes the filter
Cells.Select
Selection.AutoFilter
Hope that helps.
Try this. You need to start loop from the end :
Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("sh_test") 'edit your sheet name
Dim lastrow As Long
lastrow = ws.Range("C" & Rows.Count).End(xlUp).Row + 1 'maybe change letter of the column
For i = lastrow To 2 Step -1
If ws.Cells(i, 3).Value = "NA" And ws.Cells(i, 4).Value = "NA" Then
ws.Rows(i).EntireRow.Delete
End If
Next i
End Sub
I have some code that currently looks through the sheet for any cell that I have filled with a light grey, and then adds the value within that cell to a Names list. The goal being that somewhere else in the workbook I can reference this list as a drop down.
Here's my current code:
Sub Add_Food_To_List()
i = 1
Application.ScreenUpdating = False
Range("a1:a60").Select
x = "{"
y = ""
first = True
For Each Cell In Selection
If ActiveCell.Interior.ColorIndex = "2" Then
i = i + 1
If first = False Then
x = x & ", " & ActiveCell.Value
y = y & ", " & ActiveCell.Address
End If
If first Then
x = x & ActiveCell.Value
y = y & ActiveCell.Address
first = False
End If
ActiveWorkbook.Names("Foods").RefersTo = y
ActiveWorkbook.Names("Foods").Value = x
End If
ActiveCell.Offset(1, 0).Select
Next Cell
Range("a1").Select
Application.ScreenUpdating = True
End Sub
For some reason these two lines within the For Each Cell In Selection:
ActiveWorkbook.Names("Foods").RefersTo = y
ActiveWorkbook.Names("Foods").Value = x
overwrite each other. Whichever goes last ends up as the value that both RefersTo AND Value are set to in the name.
Bonus: This is my first VBA script. How can I get this script to run on the entire workbook, not just the active sheet? Also, how do I make it run automatically on save, or on workbook update?
Perhaps this will serve you better:
Create a Worksheet in your Workbook with the name Reference.
Type Foods in cell A1 and put at least one random food in cell A2.
Create a defined name of Foods with the following formula: =offset(A2,0,0,counta(A:A)-1,1) This is a Dynamic Named Ranges that will expand or contract as rows are added or deleted (just be sure there are no blank rows in between data).
Place the below code in the ThisWorkbook module in the VBE. The below code will run right before the Workbook saves. It will loop through each sheet and add the values of any cells highlighted grey in Range(A1:A60) to the rowset in column A of the Reference Worksheet directly underneath the existing rowset.
Code for Module:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Reference" Then
With ws
Dim rCell As Range
For Each rCell In .Range("a1:a60")
If rCell.Interior.ColorIndex = "2" Then
Dim wsRef As Worksheet
Set wsRef = Sheets("Reference")
If wsRef.Range("Foods").Find(rCell.Value, lookat:=xlWhole) Is Nothing Then
wsRef.Range("A" & wsRef.Rows.Count).End(xlUp).Offset(1).Value = rCell.Value2
End If
End If
Next
End With
End If
Application.ScreenUpdating = True
End Sub
I need to copy an entire row from a sheet and paste in another sheet with same header consider a particular column value is equal to 89581.But my VBA throws 424 error.Please help.
Sub CopyData()
Dim c As Range
Dim Row As Long
Dim sheetUse As Worksheet
Dim sheetCopy As Worksheet
Set sheetUse = Sheets("Data1").Select
Set sheetCopy = Sheets("Data2").Select
Row = 3 'Assume same header in sheet2 as in sheet1
For Each c In sheetUse.Range("O3", Sheet1.Range("O65536").End(xlUp))
If c = 89581 Then
'copy this row to sheet2
Row = Row + 1
c.EntireRow.Copy sheetCopy.Cells(Row, 1)
End If
Next c
Application.CutCopyMode = False
End Sub
Here you go, build a reference to copy then copy and paste in one go.
Sub CopyToOtherSheet()
Dim sheetUse As Worksheet, sheetCopy As Worksheet, i As Long, CopyRange As String
Set sheetUse = Sheets("Data1")
Set sheetCopy = Sheets("Data2")
For i = 3 To sheetUse.Cells(Rows.Count, 15).End(xlUp).Row
If sheetUse.Cells(i, 15) = 89581 Then CopyRange = CopyRange & "," & i & ":" & i
Next i
sheetUse.Range(Right(CopyRange, Len(CopyRange) - 1)).Copy
sheetCopy.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll 'Change to values or formats or whatever you want
Application.CutCopyMode = False
End Sub
Assumed Data1 is the sheet with the data in and Data2 is the one to copy to.
I have searched a bit for a VBA code that will list me a row reference and am not finding results. Perhaps I am missing what the actual term for it is?
I have a list of names in Column A, starting at A2. Then what I would like is a listing of 1,2,3,4,5 going down Column B, starting from B2, until the names stop.
I can do this as a formula but need to have the values set there by a macro in this case.
Can this be done?
If I understand you correctly then this should work:
Sub test()
Dim lastRow As Long, counter As Long
Dim cell As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("NAME_OF_YOUR_WORKSHEET")
lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 1
For Each cell In ws.Range("B2:B" & lastRow)
cell.Value = counter
counter = counter + 1
Next cell
End Sub
No need for a loop:
Sub NumberRows()
With Sheets("Sheet Name Here")
With .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
.Formula = "=ROW()-1"
.Value = .Value
End With
End With
End Sub
Basically what I need to do is get the value from a specific cell from a different worksheet. The tricky part is that the name of the sheet that it has to access is displayed in a column in the same sheet.
So the status column has to get the number from the other sheet. And the other sheet has to be the name from the "sheetname" column in the same row. If there is no sheet yet it should just stay empty.
Current code I have is this. All this does is create/open the other sheet so far.
Sub CreateNewSheet()
sheet_name_to_create = Range("A" & (ActiveCell.Row)).Value
' Check if filename exists, if false create new else make it active
For rep = 1 To (Worksheets.Count)
If LCase(Sheets(rep).Name) = LCase(sheet_name_to_create) Then
ActiveWorkbook.Sheets(sheet_name_to_create).Activate
Exit Sub
End If
Next
Sheets("TEMPLATE").Copy after:=Sheets(Sheets.Count)
Sheets(ActiveSheet.Name).Name = sheet_name_to_create
End Sub
Its a dutch project so ignore the words at the top btw :p
I am not sure if I get you correct but below example will use Column A data as worksheet name and return cell A1 value in that target sheet to Column B same row.
Sub findNOW()
Dim lastRow As Long
Dim WS As Worksheet
Set WS = ActiveWorkbook.Sheets("Main1")
lastRow = WS.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
On Error Resume Next
WS.Range("B" & i).Value = ThisWorkbook.Sheets(WS.Range("A" & i).Value).Range("A1").Value
Next
End Sub
From Rory's comment it looks like if you put this formula in cell B1, you would just need to know the cell in the other worksheet (A1 in the example).
=INDIRECT(A1 & "!A1")