I have one sheet named Sheet3 and another are Sheet4. Sheet3: Column A Header is Product type, and Column B is their Quantity, Sheet4 has same column Header. Product Type and Quantity. But when I Run Below Macro in Sheet3, Sometime they add values correctly to
Sheet4 and sometime they doesn't work properly.
Sub Increase_Value()
Sheets("Sheet3").Select
Cells.Find(What:=Sheet4.Range("A2").Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Sheets("Sheet4").Select
Range("A2").Select
ActiveCell.Offset(0, 1).Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Range("E10").Select
Sheets("Sheet3").Select
Cells.Find(What:=Sheet4.Range("A3").Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Sheets("Sheet4").Select
Range("A3").Select
ActiveCell.Offset(0, 1).Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Range("E10").Select
Sheets("Sheet3").Select
Cells.Find(What:=Sheet4.Range("A4").Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Sheets("Sheet4").Select
Range("A4").Select
ActiveCell.Offset(0, 1).Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveCell.Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Range("E10").Select
Sheets("Sheet4").Select
Range("A2:B4").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A2").Select
ActiveWorkbook.Save
End Sub
For Example: If Sheet3 Range A3 = **Coca Cola**, And B3 = **20**, And When I rum the macro Increase_Value(), The VBA should find the value Coca Cola in Sheet4 Column A and if value found in row 10 (A10) then add value 20 from sheet3 Range B3 to sheet4 Range B10.
If B10 is 47 then after running the macro it should be 67.
Looks like you are trying to do something that a vlookup could solve easily? You can do vlookups in VBA as well
Below is the exact formula -
'''Application.WorksheetFunction.vlookup(lookup_value, table_array, col_index_num, range_lookup)'''
You can find more information on this here:
https://excelmacromastery.com/vba-vlookup/
Thanks,
Related
Sheets("MDCF").Select
Range("B6:B100").Select
Selection.Copy
Range("J6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Replace What:="10000", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("J6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("MDCF Fund").Select
Range("F7").Select
ActiveSheet.Paste
With Sheets("MDCF Fund")
Set FOUNDRANGE = .Columns("F:F").Find("*", After:=.Range("F81"), searchdirection:=xlPrevious,
LookIn:=xlValues)
If Not FOUNDRANGE Is Nothing Then LR1 = FOUNDRANGE.Row
End With
Range("F80:F" & LR1 + 1).Select
Selection.Clear
I am trying to delete the cells that are below last cell in new sheet but its not working if the cell range is same in both copy paste ranges. trying to find a way in which I will be able to delete only redundant cell that are above F80 and below the copied cell counts.
If you want to straight away delete all the data after F80 then the below code would work,
With Sheets("MDCF Fund")
LR1 = Range("F" & Rows.count).end(xlup).row
'If you want to keep the cells between the pasted data and F80 then just add the IF condition
If (LR1 > 80) Then
Range("F80:F" & LR1).Select
Selection.clear
end if
I would like to paste a formula on a range based on a date. the dates are from column L7 to AP7 1st to the 31st. The formula should select a dynamic range below the date and paste the formula.
I did a macro and it only selects the range that was selected on the macro
s_date = Sheets("PnA").Range("L1")
Range("L5").Select
Selection.Copy
Range("L7:AP7").Select
Selection.Find(What:=s_date, After:=ActiveCell, LookIn:=xlFormulas _ ,
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False"
Selection.AutoFill Destination:=Range("L8:L673")
Range("L8:L673").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False"
This is how far I can get with the limited information you provided, it's really not clear what you are trying to accomplish
Sub finddate ()
With Workbooks(REFERENCE).Sheets(REFERENCE) 'Change
s_date = .Range("L1")
Set fdate = .Range("L7:AP7").Find(s_date, LookIn:=xlFormulas, LookAt:=xlPart)
If Not fdate is Nothing Then
fdate.Offset(0,1).AutoFill Destination:=.Range(fdate.Offset(0,1) & ":" & fdate.Offset(1,673))'I am assuming there is a formula to the right of the date which you want autofilled down
End If
End With
End Sub
I am trying to Data from one workbook and paste it in other while doing so there are some values not searchable, an error is shown. On handling the error it skips the iteration but when the second-time error occurs it is not skipping the iteration but giving the error message.
For i = 1 To lrow
On Error GoTo InvalidValue
mWkb.Activate
Sheets("Sheet2").Select
s_value = ActiveCell.Offset(i, 0).Value
Sheets("LocDB").Select
Range("G2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Find(What:=s_value, After:= _
ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
wkb.Activate
Range("G9").Select
ActiveCell.Offset(i, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
InvalidValue:
Next i
What i am tryin to do is Copy Data from another workbook into this workbook based on column header names, columns are not in the same sequece and not all columns headers are present on whiuch i hv used on error resume next
i used find function to do it, is there ant other way i can do it.
how can i replace find what in "" with a dynamic range or cell reference
here i is the column from base file which i wanty to find in dump wb
Below is my conding
For i = 1 To 50
Windows("Base.xlsm").Activate
Columns(Columns(i).Address).Select 'i is column number
ActiveSheet.Cells(8, i).Select ' this is required column hader to find
Application.CutCopyMode = False
Selection.copy
Windows("Dump.xlsx").Activate
Rows("2:2").Select
Selection.Find(What:="items", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Range(ActiveCell, Cells(ActiveCell.Row + 800000, ActiveCell.Column)).Select
Application.CutCopyMode = False
Selection.copy
Windows("Base.xlsm").Activate
Range("A9").Select 'how to select active cell in the workbook where i want to paste data.
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next i
I understand about 10% of your question. but I'll answer:
how can i replace find what in "" with a dynamic range
you can replace Find(What:="items") with a value of a range, e.g. Find(What:=Range("A1").Value), leaving you with this:
Selection.Find(What:=Range("A1").Value, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
I want the loop to query the ticker in the cell right below it and loop until it has pulled that data for all of tickers in the column.
Summary:
I am attempting to pull data from for ticker symbols in Column A
This is the code I am using.
Sub URL_Static_Query()
''Pull Data from Profile
With Sheet2.QueryTables.Add(Connection:= _
"URL;http://finance.yahoo.com/q/pm?s=" & Sheet1.Range("A2").Value & "+Performance", _
Destination:=Sheet2.Range("A1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SaveData = True
End With
''Pull Data from Performance
With Sheet3.QueryTables.Add(Connection:= _
"URL;http://finance.yahoo.com/q/pr?s=" & Sheet1.Range("A2").Value & "+Profile", _
Destination:=Sheet3.Range("A1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SaveData = True
End With
'Grab and Paste 3-month
Sheets("Sheet2").Select
Range("A1").Select
Cells.Find(What:="3-month", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
'Grab and Paste 1-Year
Sheets("Sheet2").Select
Range("A1").Select
Cells.Find(What:="1-Year", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Sheet3").Select
Range("A1").Select
Cells.Find(What:="Prospectus Net Expense Ratio:", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Sheet2.Cells.Clear
Sheet3.Cells.Clear
End Sub
You can wrap this code in a loop that goes down each cell in the column, one by one.
For example, if you're using column A,
Dim row_counter As Long, last_row As Long
row_counter = 1
'last_row = whatever your last row is
Do While row_counter < last_row
'... put looping code here
row_counter = row_counter + 1
Loop