I have an excel worksheet with whole bunch of rows and several columns in it. The 1st column contains the manufacturer's name, the 2nd column contains the product codes for all the products, the 3rd column contains the description and etc.
What I want to do is to copy the rows that corresponds to certain product codes. For example:
**Manufacturer Product code Description**
abc B010 blah blah
dgh A012
hgy X010
eut B013
uru B014
eut B015
asd G012
sof B016
uet B016
etc
Is there a way to copy the rows that has the product codes in between B010 - B016? There might be double/matching product codes too, and it is totally fine to copy them too.
Makes sense?
Sorry, i have no vba code to put in here yet.
Thanks in advance.
This should do the trick; it copies the A:C range cells for any B cell values that are between B010 and B016 to the next available row in Sheet2.
Private Sub CopyRows()
Dim lastrow As Long
Dim r1 As Long, r2 As Long
' Get the last row in the worksheet
lastrow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
r2 = 1
For r1 = 1 To lastrow
' If the last three characters of the B cell are numeric...
If IsNumeric(Right(Sheet1.Range("$B$" & r1).Value, 3)) Then
' If the first character of the B cell is "B", and the last three
' characters are between 10 and 16 ...
If Left(Sheet1.Range("$B$" & r1).Value, 1) = "B" And _
CLng(Right(Sheet1.Range("$B$" & r1).Value, 3)) >= 10 And _
CLng(Right(Sheet1.Range("$B$" & r1).Value, 3)) <= 16 Then
' ... copy the A-C range for the row to the next available row
' in Sheet2
Sheet2.Range("$A$" & r2, "$C$" & r2).Value = _
Sheet1.Range("$A$" & r1, "$C$" & r1).Value
r2 = r2 + 1
End If
End If
Next
End Sub
Related
Helloo,
I need Copy a range of data from one worksheet & paste 18 times of each data in the other worksheet.
Eg.,
I need to copy the data starting from Row 6 Column A,F,G from one sheet named "Inputs"
And need to paste the data 18 times starting from Row 6 of Column A,C,D in other sheet named "locale_Data"
So, the first data of input sheet should be pasted into Row (6:23) of sheet "locale_Data" & follows the other data in a sequential manner.
Thanks for your help!
If you have values in range say A6:A10 of Inputs worksheet and you would like to copy them in locale_Data worksheet 18 times starting at Row 6 you can do something like this.
Dim LastRow As Long
Dim i, startAt, totalRowsToCopy As Integer
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set sheet1 = ThisWorkbook.Worksheets("Inputs")
Set sheet2 = ThisWorkbook.Worksheets("locale_Data")
LastRow = sheet1.Cells(sheet1.Rows.Count, "A").End(xlUp).Row
sheet1.Range("A6:A" & (LastRow)).Copy
startAt = 6
totalRowsToCopy = LastRow - startAt + 1
For i = 1 To 18
sheet2.Range("A" & startAt & ":A" & (startAt + totalRowsToCopy - 1)).PasteSpecial
startAt = startAt + totalRowsToCopy
Next i
(Edited after Mat's suggestion)
If you just want to copy value in Row 6 18 times in another worksheet you can do something like this:
ThisWorkbook.Worksheets("Inputs").Range("A6").Copy
ThisWorkbook.Worksheets("locale_Data").Range("A6:A23").PasteSpecial
You have to repeat this code for each cells.
And if you want to change 18 to some other number you can always concatenate cell range like
Range("A6:A" & (6 + 18)).PasteSpecial
Let me know if this is not what you are looking for.
you can try something like this. Ihave shown for only one column. you can repeat for other columns. Make sure to change the range $A$1:$A$2 to your desired data range.
D1 = INDEX($A$1:$A$2,QUOTIENT(ROW()-ROW($D$1),18)+1)
I am having names in two cells of sheet1 (e.g. : B1 (Gina Williams) & B2 (Patrick Rafter)) and the corresponding bank statement narratives are in sheet 2 (column C) e.g: "Deposit from Gina towards rent for connaught place apt".
Now I need to search all the four partial texts available in cells B1 & B2 of sheet 1 (ie. "Gina", "Williams", "Patrick", "Rafter" in the entire column B of sheet 2. if there is a match i need to capture the corresponding column B & D value for the matching row.
SHEET1
Column A Column B Column C Column D
1 GINA WILLIAMS OUTPUT (matching col b of sheet2) OUTPUT (matching col D of sheet2)
2 PATRICK RAFTER OUTPUT (matching col b of sheet2) OUTPUT (matching col D of sheet2)
SHEET2
Column A Column B Column C Column D
1 12/7/2015 Deposit from Gina towards rent for connaught place apt 320
2 13/7/2015 Deposit from Rafter towards rent for connaught place apt 720
I have tried with vlookup, find, match (along with left, right, mid functions) functions.
You could use VBA to achieve this, but if you've not done VBA before, this might not be a good idea.
I would favour adding another column to sheet 2 when you manually enter the name from sheet 1 into each cell. In every cell of this new column, you can give the user a drop down list of all names that can be entered by using the excel ribbon>Data>Data Tools>DataValidation option.
This solution will work - so long as your bank statement is not enormous! If it is then you might want to do it differently. It also gets around the issue of two people on sheet1 having the same forename or surname, and is probably something you will be able to do quite quickly.
Once the above is done, you can simply use VLOOKUP in sheet 1 to fin the data on sheet 2.
KISS.
Harvey
I got one for you. I already tested the code. It work perfectly for me.
But, not grantee for duplicate naming , means, it can't give right result for duplicate names and duplicate deposit.
Here the code:
Sub findAndGet()
Dim sh1, sh2 As Worksheet
Dim tempRow1, tempRow2 As Integer
Dim strList() As String
Dim name As String
Dim index As Integer
'Set sheets
Set sh1 = Sheets("list")
Set sh2 = Sheets("search")
'Set the start row of Sheet1
tempRow1 = 1
'Loop all row from starRow until blank of column A in Sheet1
Do While sh1.Range("A" & tempRow1) <> ""
'Get name
name = sh1.Range("B" & tempRow1)
'Split by space
strList = Split(Trim(name), " ")
'Set the start row of Sheet2
tempRow2 = 1
'Reset flag
isFound = False
'Loop all row from startRow until blank of column A in Sheet2
Do While sh2.Range("A" & tempRow2) <> ""
For index = LBound(strList) To UBound(strList)
'If part of name is found.
If InStr(UCase(sh2.Range("C" & tempRow2)), UCase(strList(index))) > 0 Then
'Set true to search flag
isFound = True
'exit do loop
Exit Do
End If
Next index
'Increase row
tempRow2 = tempRow2 + 1
Loop
'If record is found, set output
If isFound Then
'set date
sh1.Range("C" & tempRow1) = sh2.Range("B" & tempRow2)
'set amount
sh1.Range("D" & tempRow1) = sh2.Range("D" & tempRow2)
End If
'Increase row
tempRow1 = tempRow1 + 1
Loop
End Sub
I have a excel sheet which I am populating using a VB program. The output sheet can have variable number of rows but has 6 columns (A:F). Now I want the column G to have hex2dec of all the rows in column A. Here's an example: Say column A has 400 rows (A1:A400) then I want G1:G400 to have values HEX2DEC(A1:A400). But this is just an example the rows can vary. I have this code so far:
Sub DataMod()
Dim i As Long, R3 As Long
R3 = 1
For i = 1 To sheet.UsedRange.Rows.Count
sheet.Cells(i, 7).Formula = "=HEX2DEC" & sheet.Cells(R3, 1)
R3 = R3 + 1
Next i
End Sub
But it's not working.
Review your HEX2DEC formula string
it doesn't include the necessary ()
the Cells() would return the value of the target cell, not its address (i.e. the result would be =HEX2DEC(1234) instead of =HEX2DEC(A1) - which may or may not be a problem
you could use variable i instead of R3, they both increment from the same starting point at the same increment
I recommend to use FormulaR1C1, you do not have variants there
Sub DataMod()
Dim C As Range
For Each C In ActiveSheet.UsedRange.Columns(1).Cells
C(1, 7).FormulaR1C1 = "=HEX2DEC(RC[-6])"
Next C
End Sub
The danger of UsedRange is that it might include any header rows, so you might want to get around this by selecting the input range manually before you fire your Sub() and work with the Selection object, e.g.
For Each C In Selection.Columns(1).Cells
Try This:
Sub DataMod()
' Get the number of rows used in Column A:
Dim NumRows as Long
NumRows = Range("A1").End(xlDown).Row
' Put the formulas in Column G all at once:
Range("G1:G" & NumRows).FormulaR1C1 = "=Hex2Dec(RC1)"
End Sub
I am looking to update the last column of one data table with the last column of another data table. This is part of a bigger vba code. The first table spreads from A2 to column K and row "lastrpivot1". The second goes from A1001 to column K and row "lastrpivot2". Beginning with the first row of table 2 (row1001) i have to find the equivalent row in table 1 based on the values in cells A to E.
So cells A to E or frow 1001 have to be compared to cells A to E of row 2, then row 3, then row 4... until a match if found or until row "lastrpivot1". When a match is found, the value in K must return to the K value of row 1001. EX: if AtoE of row 1001 match row AtoE of row 65, then copu K65 to K1001. there shound not be more than 1 match from each table. and if there is no match there is nothing to return.
Then we start this all over for row 1002 (second row of second chart), then 1003, 1004... to lastrpivot2.
I do use vba but i do not know all the functions. this is probably why i cant figure this out.
Thnka you
In Cell K1001, try this:
=IF((A1001&B1001&C1001&D1001&E1001)=(A1&B1&C1&D1&E1),K1,"")
Then drag the formula down.
This compares the entire row 1001 to the entire row 1, which is what you're asking for.
If you intend to find the matching row like a VLOOKUP (you kind of imply this, but it is not clear that this is your intention) then you will need to use VBA to do this.
Something like (untested):
Sub MatchTables()
Dim tbl1 as Range, tbl2 as Range
Dim var1() as Variant, var2() as Variant, v as Variant
Dim r as Long, matchRow as Long
Set tbl1 = Range("A1:K500") '## Modify as needed
Set tbl2 = Range("A1001:K15001") '## Modify as needed
ReDim var1(1 to tbl1.Rows.Count)
ReDim var2(1 to tbl2.Rows.Count)
'## store the range values, conctaenated, in array variables:
For r = 1 to tbl1.Rows.Count
var1(r) = tbl1(r,1) & tbl1(r,2) & tbl1(r,3) & tbl1(r,4) & tbl(r,5)
Next
For r = 1 to tbl2.Rows.Count
var2(r) = tbl2(r,1) & tbl2(r,2) & tbl2(r,3) & tbl2(r,4) & tbl2(r,5)
Next
r = 0
For each v in Var2
r = r+1
'## Check to see if there is a complete match:
If Not IsError(Application.Match(v, var1, False)) Then
matchRow = Application.Match(v, var1, False)
'## If there is a match, return the value from column K in the first table:
tbl2.Cells(r,11).Value = tbl1.Cells(matchRow,10).Value
Else:
tbl2.Cells(r,11).Value = vbNullString
End If
Next
End Sub
I am doing a lot of manual work and I tried finding relevant macros, but unfortunately could not find any.
Basically, my Excel sheet has 4 columns (A, B, C, D). I am left with data in columns A and B after doing a lot of screening on the current month's company filings (I remove certain marcaps above and below my range, I remove data not relevant to not my sector, etc.).
Column A has the company name (upper case, lower case and sometimes combination)
Column B has the date (I am doing by month now)
Once these 2 columns are ready, I run a web query from website, which downloads the entire month's filings with SEC with hyperlinks.
Column C has the Company Name with HYPERLINKS (not necessarily same case formatting as in Col A)
Column D has the Date (I am downloading monthly, so that will be the same month)
Column C has data that is much more than Col A; it has all the unwanted companies' hyperlinks too and there is no way that the search on that website can be more customized than to the extent it currently is.
Col D is much longer than Col B, because of more filings
e.g.:
Col A Col B Col C Col D
(Hyperlinks)
Abc 3/1/2008 AAA 3/1/2008
BCD 3/1/2008 AAB 3/1/2008
BCD 3/2/2008 AAC 3/1/2008
cDE 3/2/2008 ABC 3/1/2008
DeF 3/3/2008 ABE 3/1/2008
BCD 3/1/2008
ABC 3/2/2008
BCD 3/2/2008
CDE 3/2/2008
AAA 3/3/2008
AAF 3/3/2008
DEF 3/3/2008
I need the company in Col C to replace Col A with its Hyperlink, provided they are on the same date (Col B=Col D), irrespective of case (company names are unique).
The order of the companies in Col A and C are not same, even if I sort 'A-Z' for these columns, because of unwanted companies' data in Col C. C is a much longer column than A.
Each month has 1200 to 1500 filings and I am checking manually and replacing manually date-wise. I have to do this for 3 years, I am still in the same month for past 10 days. There is still more: I have to open each filing and read through and update the remarks column.
I believe the code below does what you seek.
I created this worksheet to match your image:
The macro below changes the worksheet to:
Columns C and D are now redundent since every value in those columns has been moved to column F and G.
Hope this helps.
Edit
Meena ran the macro against her data but it did not match all the values that should have been matched. She emailed me a copy of her data. Having examined her data, I have made three changes to the macro below:
Meena's worksheet has no heading row. I use a constant to specify the first data row. I have changed the value from 2 to 1.
Many of the reference values have trailing spaces. I have used TRIM() to remove those trailing spaces before the comparisons.
The macro creates two new columns of data. These were left at the default width so if the value was long, it would wrap and require several lines. I have now added code to copy the the column widths from the source columns to the destination columns.
.
Option Explicit
' If the columns have to be moved, update these constants
' and the code will change to match.
Const ColRefCompany As Long = 1
Const ColRefDate As Long = 2
Const ColWebCompany As Long = 3
Const ColWebDate As Long = 4
Const ColSaveCompany As Long = 6
Const ColSaveDate As Long = 7
Const ColLastLoad As Long = 4
Const RowDataFirst As Long = 1 ' No header row
Sub CopyWebValuestoSaveColumns()
Dim CellValue() As Variant
Dim ColCrnt As Long
Dim Rng As Range
Dim RowRefCrnt As Long
Dim RowSave() As Long
Dim RowSaveCrnt As Long
Dim RowWebCrnt As Long
Dim RowLast As Long
' Find the last cell with a value
With Worksheets("Sheet1")
Set Rng = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Rng Is Nothing Then
Call MsgBox("Sheet is empty", vbOKOnly)
Exit Sub
End If
RowLast = Rng.Row
' Load all reference and web values to CellValue. Searching an array
' is faster than searching the worksheet and hyperlinks are converted
' to their display values which gives an easier comparison.
' Note for arrays loaded from a worksheet, dimension one is for rows
' and dimension two is for columns.
CellValue = .Range(.Cells(1, 1), .Cells(RowLast, ColLastLoad)).Value
' RowSave() will record the position in the save columns of the values
' in the web columns. Allow for one entry per row in web list.
ReDim RowSave(1 To RowLast)
RowRefCrnt = RowDataFirst
' Set web company names to lower case and remove leading and trailing
' spaces ready for matching
For RowWebCrnt = RowDataFirst To RowLast
CellValue(RowWebCrnt, ColWebCompany) = _
Trim(LCase(CellValue(RowWebCrnt, ColWebCompany)))
Next
Do While True
If CellValue(RowRefCrnt, ColRefCompany) = "" Then
' Empty cell in reference company column. Assume end of list
Exit Do
End If
' This loop makes no assumptions about the sequence of the
' Reference and Web lists. If you know their sequences match or
' if you can sort the two pairs of columns, this loop could be
' made faster
' Set reference company name to lcase and remove leading and trailing
' spaces ready for matching
CellValue(RowRefCrnt, ColRefCompany) = _
Trim(LCase(CellValue(RowRefCrnt, ColRefCompany)))
For RowWebCrnt = RowDataFirst To RowLast
If CellValue(RowRefCrnt, ColRefCompany) = _
CellValue(RowWebCrnt, ColWebCompany) And _
CellValue(RowRefCrnt, ColRefDate) = _
CellValue(RowWebCrnt, ColWebDate) Then
' Reference and web values match.
' Record that the web values from row RowWebCrnt
' are to be copied to row RowRefCrnt
RowSave(RowWebCrnt) = RowRefCrnt
Exit For
End If
Next
RowRefCrnt = RowRefCrnt + 1
Loop
RowSaveCrnt = RowRefCrnt ' First row in save column that is available
' for unused web values
For RowWebCrnt = RowDataFirst To RowLast
If RowSave(RowWebCrnt) = 0 Then
' The web values on this row has not been matched to reference values.
' Record these web values are to be moved to the next available row
' in the save columns
RowSave(RowWebCrnt) = RowSaveCrnt
RowSaveCrnt = RowSaveCrnt + 1
End If
Next
.Columns(ColSaveCompany).ColumnWidth = .Columns(ColWebCompany).ColumnWidth
.Columns(ColSaveDate).ColumnWidth = .Columns(ColWebDate).ColumnWidth
' Copy values from web columns to save columns
For RowWebCrnt = RowDataFirst To RowLast
.Range(.Cells(RowWebCrnt, ColWebCompany), _
.Cells(RowWebCrnt, ColWebDate)).Copy _
Destination:=.Cells(RowSave(RowWebCrnt), ColSaveCompany)
Next
End With
End Sub