Selecting a cell and copiying the corresponding cells in the row in VBA - vba

I am trying to build a macro and I want to copy a row after selecting a specific cell with the filter. So I filter a cell in column "A" and then I want to copy all the cells in that row. The problem is that the rownumber corresponding to the selected cell may change, due to different datasets.
Below is the code:
Selection.AutoFilter
ActiveSheet.Range("$A$1:$DO$46").AutoFilter Field:=2, Criteria1:= _
"NAME"
Range("A5:DO5").Select
Selection.Copy
The point is that in VBA the selection is set at "A5:DO5", because in this specific dataset "NAME" is on "A5".
But in a different dataset "NAME" might be on "A9", but in VBA the selection of the row is still on "A5:DO5".
How can I make the selection of "NAME" and the copy of all the cells in the row of "NAME" linked to eachother?

I think the question could be a bit clearer, but here goes.
As I understand it you want to copy a row, say 5th row down, after a filter has been applied to hide some rows in between (5th visible row).
Or, you want to find "NAME" and copy the corresponding row, irrespective of what's hidden and what isn't.
(If I haven't got the above right, please let me know and/or consider clarifying the question)
Try something like this;
Dim C as Cell
Dim RowNum as Integer 'If you're looking for the 5th visible cell.
For each C in Range("A:A").SpecialCells(xltypeVisible)
RowNum = RowNum+1 'Count how many visible cells you've looped
If C.Value = "NAME" Then
'Or for the 5th visible cell, use 'If RowNum = 5 Then'
C.EntireRow.Copy
Exit For
End If
Next

Thank you for your answer. Unlukily, the code is not working.
To clarify:
I want to find "NAME" in Column "B" and copy the corresponding row of "NAME", irrespective of what's hidden and what isn't.
Now I have this code:
Dim C As Range
For Each C In Range("B:B")
If C.Value = "NAME" Then
C.EntireRow.Copy
Exit For
End If
Next
The code does copy a row, but not the row that corresponds with "NAME". Instead, it copies the first row in the active sheet.

Related

Copy rows based on cell value and paste on a new sheet

Check This
I need a help. I want to copy whole cell from A sheet name "Components" only if value in Column C is > 0 to a new Sheet name "Load list"
Can someone please give me the macro code for this?
on your new sheet you can add this condition the cell or range of cells:
=IF(Components!C5>0,Components!A5)
where C5 has thevalue to compare, and A5 has the value copy if the condition happens.
Right in my swing!
The formula given by #sweetkaos will work fine, in case you want to replicate the data as it is with blanks where data is not found.
I will imagine a slightly more complicated situation. I am assuming you want just one line in the next format as is shown in your image.
Also conveniently assuming the following:
a. both sheets have fixed start points for the lists
b. 2 column lists - to be copied and pasted, with second column having value
c. Continuous, without break source list
d. basic knowledge of vba, so you can restructure the code
Here is the code. Do try to understand it line by line. Happy Excelling!
Sub populateLoadList()
'declaring range type variables
Dim rngStartFirstList As Range, rngStartLoadList As Range
'setting values to the range variables
'you must change the names of the sheets and A1 to the correct starts of your two lists
Set rngStartFirstList = Worksheets("Name_of_your_fist_sheet").Range("A1")
Set rngStartLoadList = Worksheets("Name_of_your_second_sheet").Range("A1")
Do While rngStartFirstList.Value <> ""
If rngStartFirstList.Offset(1, 0).Value < 0 Then
Range(rngStartFirstList, rngStartFirstList.Offset(0, 1)).Copy
rngStartLoadList.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Set rngStartLoadList = rngStartLoadList.Offset(1, 0)
End If
Set rngStartFirstList = rngStartFirstList.Offset(1, 0)
Loop
End Sub
Basically what i want is ... if Value on C is >0 i want whole column 10 copied to that new sheet .... not only that cell

Creating muliple ranges based on criteria in column

New to VBA, and I'm trying to create multiple ranges or arrays based on a criteria in a column, then place those in a separate worksheet. The issue is that this code has to work for several different data sets. So one data sat will look something like
this, but with far more data points ( around 10,000 for each data set).
So what I'm trying to do is, for each group of 1's in the state column, create a range/array, then move the corresponding time and data in a new worksheet. So for the example I have, there would be 3 new worksheets, with the first new worksheet containing range("A2:B5"), the second one containing range("A10:B12"). With each data set, the state column changes and the number of new worksheets can also vary.
I have looked through this site, and the closest I have found to my needs is Creating Dynamic Range based on cell value, but it has a known number of ranges. I quite honestly have no idea how to accomplish what I need. I've been trying to make a while loop inside of a if then loop inside of a for each loop, but can't make it work.
Any help would be greatly appreciated! Been banging my head for hours now.
this should help you:
Option Explicit
Sub main()
Dim area As Range
With Sheets("myDataSheet") '<--| reference your sheet (change "myDataSheet") to your actual sheet name
With .Range("C1", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its columns A:C range form row 1 down to last column A not empty row
.AutoFilter Field:=3, Criteria1:="1" '<--| filter referenced range on its 3rd column (i.e. "State") with 1
If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any filterd cells other than header
For Each area In .Resize(.Rows.Count - 1, 2).Offset(1).SpecialCells(xlCellTypeVisible).Areas '<--| loop through filtered range (skipping header) 'Areas'
area.Copy Sheets.Add(Sheets(Sheets.Count)).Range("A1") '<--| copy current 'Area' into new sheet
Next area
End If
End With
.AutoFilterMode = False
End With
End Sub

Overwrite row data in one sheet with data from a second sheet satisfying 4 conditions

I've looked at several threads and there are some that touch on my problem, however, I've never used VBA and haven't a clue how to change the coding to suit my problem.
I would like to overwrite rows of data on sheet 2 from sheet 1, providing the data in columns A, B, C & D (live data starting row 2) are a match on both sheets 1 & 2.
Essentially sheet 2 is my data store, and sheet 1 is a template of sheet 2. All the possible combinations of data in the first four columns already exist in sheet 2 with the remaining data in the row unknown. So when I get that unknown data, I would like to overwrite that row in sheet 2.
A lot of people have made threads about copying rows over where one specific term is searched for in a column, whereas, I will have many different terms to search for, but as I said, they will need to be a match on both sheets.
Hope I've made sense! Please help!
You may be able to do this with a formula rather than using VBA.
Paste this formula into cell E1 of sheet1 if you have no headers:
=IF(AND(A1=INDEX(Sheet2!A:A,MATCH(A1,Sheet2!A:A,FALSE)),B1=INDEX(Sheet2!B:B,MATCH(B1,Sheet2!B:B,FALSE)), C1=INDEX(Sheet2!C:C,MATCH(C1,Sheet2!C:C,FALSE)),D1=INDEX(Sheet2!D:D,MATCH(D1,Sheet2!D:D,FALSE))),INDEX(Sheet2!E:E,MATCH(A1,Sheet2!A:A,FALSE)),"NO")
Or this one into E2 if you have a header row:
=IF(AND(A2=INDEX(Sheet2!A:A,MATCH(A2,Sheet2!A:A,FALSE)),B2=INDEX(Sheet2!B:B,MATCH(B2,Sheet2!B:B,FALSE)), C2=INDEX(Sheet2!C:C,MATCH(C2,Sheet2!C:C,FALSE)),D2=INDEX(Sheet2!D:D,MATCH(D2,Sheet2!D:D,FALSE))),INDEX(Sheet2!E:E,MATCH(A2,Sheet2!A:A,FALSE)),"NO")
Then drag that across using the little toggle on the bottom right of the cell as far across sheet1 as you want the columns to come in from your sheet2.
Then highlight the whole row you just created and drag the little toggle at the bottom right as far down the sheet as you have data (or try double clicking the toggle to auto fill down).
I tried this on a small set of data and it seems to work so it should work for your larger data set as long as all possible variations of the 4 columns on sheet1 are available on sheet2 with associated data in the following columns.
If you get a result of "NO" in any cell then Excel can't find a row in sheet2 which has the exact combination matching the one on sheet1.
EDIT - UPDATED ANSWER BELOW.
Try this, which is much more likely to work for you.
Sub CopyItOver()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
For Each c1 In sh1.Range("A1", sh1.Range("A1").End(xlDown))
For Each c2 In sh2.Range("A1", sh2.Range("A1").End(xlDown))
If c2.Value = c1.Value Then
If c2.Offset(0, 1).Value = c1.Offset(0, 1).Value Then
If c2.Offset(0, 2).Value = c1.Offset(0, 2).Value Then
If c2.Offset(0, 3).Value = c1.Offset(0, 3).Value Then
c1.EntireRow.Value = c2.EntireRow.Value
End If
End If
End If
End If
Next c2
Next c1
End Sub

Excel: Check if cell string value exists in column, and get all cell references to that string

I suspect this may be a job for VBA, which is beyond my abilities. But here's the scenario:
Column A in Sheet 1 (CAS1) contains x rows of text values
Column A in Sheet 2 (CAS2) contains x rows of text values
Part A - For each row value in CAS1, I need to know if the string is contained in any of the cells in CAS2. Not exact match, the string can be only part of the searched cells.
Part B - I need to know the cell value of each cell in CAS2 that contains the CAS1 value (if they do exist, they can be listed in the cells adjacent to the cell being searched in CAS1).
I've tried the following to attempt Part A, all to no avail:
vlookup(A1,sheet2!A:A,1,false)
NOT(ISNA(MATCH(A1,sheet2!A:A,0)))
ISNUMBER(MATCH(A1,sheet2!A:A,0))
COUNTIF(sheet2!A:A,A1)>0
IF(ISERROR(MATCH(A1,sheet2!A:A, 0)), "No Match", "Match")
I know some of the cell values in CAS2 contain the cell values in CAS1, so I don't know why they return false or No Match. I suspect it may be down to the nature of the text content. So here's some sample data:
CAS1
LQ056
RV007H
RV008
RV009H
TSN304
TSN305
CAS2
RV009-satin-nickel-CO.jpg
STR314.jpg
STR315.jpg
HCY001.jpg
RV008-oval-rad-CO.jpg
HCY001-BRAC006.jpg
Any help would be appreciated.
This problem can be faced through VBA (at least, I imagine the VBA solution much more easily than the possible Excel one). You need a macro that, for each row in CAS1, search the content in each row of CAS2 and returns you the address.
For Each cell In Sheets("CAS1").Range("A1:A" & Sheets("CAS1").Range("A1").End(xlDown).Row) '<-- check each cell of the range A1:A? of sheet CAS1 (adapt "A" and "1" if they're different)
recFound = 0 '<-- count how many findings there are
For Each cell2 In Sheets("CAS2").Range("A1:A" & Sheets("CAS2").Range("A1").End(xlDown).Row) '<-- check in each cell of the range A1:A? of sheet CAS2 (adapt "A" and "1" if they're different)
If InStr(cell2.Value, cell.Value) <> 0 Then '<-- if the value in cell is contained in the value in cell2..
recFound = recFound + 1 '<-- account the new finding
cell.Offset(0, recFound) = Split(cell2.Address, "$")(1) & Split(cell2.Address, "$")(2) '<--write the address on the right of the currently searched cell
End If
Next cell2
Next cell
All the above should be enclosed in a macro, e.g. Sub makeMySearch(), that should be run to get the results. As commented in my code, I'm assuming that data are in A1:A? of both sheets; but they of course might be, for example, in B5:B? of the sheet 1 and in C7:C? of the sheet 2. You need clearly to adapt the code to your current data.
There's no need for VBA. Some simple array-formulas can do the job.
To see if the entry in CAS1 is present in CAS2:
=OR(ISNUMBER(SEARCH(A2,CAS2_)))
will return TRUE or FALSE. BUT this formula has to be entered by holding down CTRL-SHIFT while hitting ENTER If you do this correctly, Excel will place braces {...} around the formula that you can see in the formula bar.
The SEARCH function returns an array of results, which will be either the #VALUE! error, or a number.
In order to return the address, the following array-formula can be entered adjacent to a cell in CAS1:
=IFERROR(ADDRESS(LARGE(ISNUMBER(SEARCH($A2,CAS2_))*ROW(CAS2_),COLUMNS($A:A)),1),"")
Fill right for the maximum number of addresses possible, then select the group and fill down.
In this case, the array being returned is a string of either 0's, or 1 * the row number (i.e. the row number). I assumend the data in CAS2 was in column A, but you can change the column number if needed (or even compute it if necessary, by replacing the 1 in the ADDRESS function with COLUMN(CAS2_))
CAS1_ and CAS2_ are either named ranges, or absolute range references to the two text groups.

VBA Go to last empty row

I have a project on excel macro, I need to highlight the next last row that has an empty value. example cell A1:A100 have data and the next cell is A101 is empty.
when user click a button it should highlight the cell A101...
If you are certain that you only need column A, then you can use an End function in VBA to get that result.
If all the cells A1:A100 are filled, then to select the next empty cell use:
Range("A1").End(xlDown).Offset(1, 0).Select
Here, End(xlDown) is the equivalent of selecting A1 and pressing Ctrl + Down Arrow.
If there are blank cells in A1:A100, then you need to start at the bottom and work your way up. You can do this by combining the use of Rows.Count and End(xlUp), like so:
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Going on even further, this can be generalized to selecting a range of cells, starting at a point of your choice (not just in column A). In the following code, assume you have values in cells C10:C100, with blank cells interspersed in between. You wish to select all the cells C10:C100, not knowing that the column ends at row 100, starting by manually selecting C10.
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlUp)).Select
The above line is perhaps one of the more important lines to know as a VBA programmer, as it allows you to dynamically select ranges based on very few criteria, and not be bothered with blank cells in the middle.
try this:
Sub test()
With Application.WorksheetFunction
Cells(.CountA(Columns("A:A")) + 1, 1).Select
End With
End Sub
Hope this works for you.
This does it:
Do
c = c + 1
Loop While Cells(c, "A").Value <> ""
'prints the last empty row
Debug.Print c