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
Related
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,
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 need to get next record in "SQL" sheet. I have written code to find the value from "temp1" sheet but i want find next value.
Sub Macro1()
Sheets("candidate data").Select
With ActiveSheet
.Cells(.Rows.Count, 1).End(xlUp).EntireRow.Select
.Cells(.Rows.Count, 1).End(xlUp).EntireRow.Copy
'Participant details gets updated
Sheets("Temp1").Activate
'Paste the row in a transpose format
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Rows("1:1").Select
Application.CutCopyMode = False
'Search for email
Dim myvar As Variant
'Store the name of the assessee in a variable
myvar = Worksheets("Temp1").Range("A8").Value
'Search for this assesee name in the list and select the row where the candidate name is there
'but i need find next value at this point from "SQL" sheet and paste the value in "temp2" sheet
Sheets("SQL").Select
Cells.Find(What:=myvar, after:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
'Select the entire row
ActiveCell.EntireRow.Copy
'Participant details gets updated
Sheets("Temp2").Activate
'Paste the row in a transpose format
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Rows("1:1").Select
Application.CutCopyMode = False
End With
End Sub
I'm new with VBA for excel and asking for your expertise.
I made a recording Marco witch works totaly fine, the problem is that I know it can be shorter and look more nicer, and maybe go even faster to run.
I've read that the .Select shall be avoided as much as possible, and when recording Macros, it does this automatically.
Sub Audit_chat()
Range("R13").Select
Selection.Copy
Range("F2:K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "[h]:mm:ss"
Columns("F:K").Select
Selection.Replace What:="No Value", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B:B,C:C,N:N,O:O").Select
Range("O1").Activate
Selection.Copy
Sheets("Agents").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048575").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
Columns("D:D").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Sheets("Counter").Select
Range("A1").Select
End Sub
Can this be fixed, or am I "doomed" for life? :)
Explaination of what it does.
Range("R13").Select
Selection.Copy
'' Copy a blank cell
Range("F2:K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'' Select Range F2:K2 all the way to the end of the columns
Selection.NumberFormat = "[h]:mm:ss"
'' set the numbers to [h]:mm:ss
Reason: The file I has have the cells in the wrong format, and even if I change the format, It will not update, but I found out that If I copied a blank cell over it as a special paste with "Value" and "Add" it fixed the problem.
Columns("F:K").Select
Selection.Replace What:="No Value", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'' In Colums F:K find and replace "No Value" (Text) to "0"
Range("B:B,C:C,N:N,O:O").Select
Range("O1").Activate
Selection.Copy
Sheets("Agents").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'' Copy all data in B:B,C:C,N:N,O:O, and paste it in Sheet "Agents"
ActiveSheet.Range("$A$1:$D$1048575").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
'' Remove duplicates in all cells A:D and has a header
Columns("D:D").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
'' Copy the all the information from colum D and paste it in C
Sheets("Counter").Select
Range("A1").Select
'' Go to Sheet "Counter"
Thanks in advance.
Best Regards,
Peter
Writing code like the macro recorder will be a nightmare to maintain.
Here's my attempt at a cleanup (Far, far from perfect)(untested);
Sub x()
'///////////////////
'// First Action //
'/////////////////
Range("R13").Select
Selection.Copy
Range("F2:K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "[h]:mm:ss"
'// Try //
Sheets("MySheet").[F2:K2].Value = [R13].Value
Sheets("MySheet").[F2:K2].NumberFormat = "[h]:mm:ss"
'////////////////////
'// Second Action //
'//////////////////
Columns("F:K").Select
Selection.Replace What:="No Value", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'// Try //
Sheets("MySheet").[F:K].Replace What:="No Value", Replacement:="0", LookAt:=xlPart
'///////////////////
'// Third Action //
'/////////////////
Range("B:B,C:C,N:N,O:O").Select
Range("O1").Activate
Selection.Copy
Sheets("Agents").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048575").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
'// Try //
Sheets("MySheet").Range("B:B,C:C,N:N,O:O").Copy Sheets("Agents").[A1]
Sheets("Agents").[A:D].RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
'////////////////////
'// Fourth Action //
'////////////////////
Columns("D:D").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Sheets("Counter").Select
Range("A1").Select ' I think this only exists to go back to where you started
'// Try //
Sheets("Mysheet").[D:D].Copy [C:C]
'////////////////////////
'// So, total code is //
'//////////////////////
Sheets("MySheet").[F2:K2].Value = [R13].Value
Sheets("MySheet").[F2:K2].NumberFormat = "[h]:mm:ss"
Sheets("MySheet").[F:K].Replace What:="No Value", Replacement:="0", LookAt:=xlPart
Sheets("MySheet").Range("B:B,C:C,N:N,O:O").Copy Sheets("Agents").[A1]
Sheets("Agents").[A:D].RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
Sheets("Mysheet").[D:D].Copy [C:C]
End Sub
If you activate/select a cell/sheet to manipulate it, you're doing yourself a disservice, you should never need to*
* = Unless the macro/code is to specifically access a cell/sheet of interest (Like a "go to agents list sheet" button or something)
Whew! That is some ugly code. When you record a macro the result isn't easy to read.
Can you tell me what you're trying to do? That will help me to clean-up your code.
".Activate" vs. ".Select"
Also here is the layman's explanation on the difference between "Activate" and "Select":
With ".Select", for example worksheets, you can have more than one worksheet selected. ".Select" allows you to conduct operations on multiple objects at one time.
With ".Activate", for example worksheets, only allows you to have one worksheets active at a time. So in the below code you will have three worksheets that are selected but only one activated.
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("Sheet2").Activate
In the below code you will only have one worksheet selected.
Worksheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("Sheet2").Select
The reason why ".Select" can get you in trouble is because if you select several objects you will conduct operations on all of the objects you select. You may or may not want that. Using ".Activate" limits your operations to only one object.
Solution 01
Below is the first attempt at a solution. In general I would recommend using the VBA objects and Excel objects to your advantage and comment the code well. Below is one option on how to do that.
The code is longer but it is clearer and much easier to understand while taking advantage of the VBA / Excel object library.
I have not tested the below code.
Sub Audit_chat()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' variables / object declaration
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' declare objects
Dim wks_dest As Worksheet, wks_source As Worksheet
Dim rng_srce_copy_01 As Range, rng_dest_01 As Range, rng_srce_copy_02 As Range
Dim rng_dest_dup_01 As Range, rng_srce_copy_03 As Range
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' variables / object initialzation
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' set worksheet objects
' I don't know the name of the source worksheet
Set wks_source = Worksheets("<Source Worksheet Name>")
Set wks_dest = Worksheets("Agents")
' set source range objects
Set rng_srce_copy_01 = wks_source.Range("R13")
Set rng_srce_copy_02 = wks_source.Range("O1")
Set rng_srce_copy_03 = wks_dest.Range("D:D")
' set desstination range objects
Set rng_dest_01 = wks_source.Range("F:K")
Set rng_dest_dup_01 = wks_dest.Range("$A$1:$D$1048575")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' start main method
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' copy the source 01
rng_srce_copy_01.Copy
' paste information from range_srce_copy_01
With rng_dest_01
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlAdd, _
SkipBlanks:=False, _
Transpose:=False
' change cell format
.NumberFormat = "[h]:mm:ss"
' replace "No Value" with 0
.Replace What:="No Value", _
Replacement:="0", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End With
' application mode turn off
Application.CutCopyMode = False
' copy source 02
' this will only copy one cell "O1" which is what your code is doing
' if you want to copy columns B, D, N, O then you need to define your
' range objct as:
' Set rng_srce_copy_02 = Range("B:B,C:C,N:N,O:O")
' this is where Select vs. Activate gets you in trouble
' do you want all the colums or just cell?
rng_srce_copy_02.Copy
' go to destination worksheet
' you may have to break this up into:
' wks_dest.Activate
' Range("A1").Activate
' but I don't think so
wks_dest.Range("A1").Activate
wks_dest.Paste
' application mode turn off
Application.CutCopyMode = False
' look at all the cells in the first two columns and remove
' the duplicates
rng_dest_dup_01.RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
' copy range 03
rng_srce_copy_03.Copy
' paste at cell C1
Range("C1").Select
wks_dest.Paste
' go to "Counter" worksheet
Worksheets("Counter").Activate
Range("A1").Activate
End Sub
you can try to "Join" the range("").select with the next line, for example
Range("R13").Select
Selection.Copy
Can be:
Range("R13").Copy
Try this:
Sub Audit_chat()
Range("R13").Copy
Range("F2:K2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Selection.NumberFormat = "[h]:mm:ss"
Columns("F:K").Replace What:="No Value", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("O1").Copy
Sheets("Agents").Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$D$1048575").RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
Columns("D:D").Copy
Range("C1").Select
ActiveSheet.Paste
Sheets("Counter").Range("A1").Select
End Sub
I have a macro :
Sheets("AMEND ESTIMATE").Select
Cells.Find(What:=Sheets("AMEND QUOTE").Range("G4").Value, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(41, 3).Select
Selection.Copy
Sheets("AMEND QUOTE").Select
Range("G4").Offset(14, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'#2
Sheets("AMEND ESTIMATE").Select
Cells.Find(What:=Sheets("AMEND QUOTE").Range("H4").Value, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(41, 3).Select
Selection.Copy
Sheets("AMEND QUOTE").Select
Range("H4").Offset(14, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'#3
Sheets("AMEND ESTIMATE").Select
Cells.Find(What:=Sheets("AMEND QUOTE").Range("I4").Value, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(41, 3).Select
Selection.Copy
Sheets("AMEND QUOTE").Select
Range("I4").Offset(14, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
As you have seen, this macro finds a range from Amend Quote inside AMEND ESTIMATE(worksheets), gets a value and pastes in a certain offset cell in Amend Quote.
This was working fine, but now it is throwing run time error 91.
Can you please help me.
The issue is that your find isn't finding anything. You need to put a bit of error handling to account for when the find returns no result, by setting the result of the find action to a variable and then doing the activate on the variable only if there's something there.
Something like this:
EDIT - updated code below including behaviour to allow the sub to exit if the search term isn't found or if the search term is a zero length string.
I've also tidied up your code a lot to remove 'select then manipulate' - you can manipulate the cells without selecting them first, it'll save a lot of processing time.
Finally I've condensed the whole 50 iterations into a single loop rather than repeating the same action 50 times changing the cell reference by 1 column each time.
Please remember to accept my answer as correct if it helps you.
Sub test()
Dim rng As Range
Dim aEst As Worksheet, aQuo As Worksheet
'Set your sheet names into variables for easier referencing
Set aEst = Sheets("AMEND ESTIMATE")
Set aQuo = Sheets("AMEND QUOTE")
For i = 7 To 57 '7 = Column H, 8 = Column G, etc.
'Set the address of the found value to the rng variable
Set rng = aEst.Cells.Find(What:=aQuo.Cells(4, i).Value, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rng Is Nothing Then 'CHECK IF THE SEARCH TERM (FROM QUOTE SHEET) WAS FOUND IN THE TARGET SHEET (ESTIMATE)
If Not rng = "" Then 'CHECK IF THE SEARCH TERM WAS A ZERO LENGTH STRING
rng.Offset(41, 3).Copy 'Copy the cell 41 rows down and 3 columns across
aQuo.Cells(4, i).Offset(14, 0).PasteSpecial Paste:=xlPasteValues 'Paste into the cell 14 rows below the original search term in the QUOTE sheet
ElseIf rng = "" Then 'EXIT SUB IF SEARCH TERM WAS A ZERO LENGTH STRING
MsgBox "Work is Done"
Exit Sub
End If
ElseIf rng Is Nothing Then 'EXIT SUB IF SEARCH TERM WAS NOT FOUND IN THE TARGET SHEET
MsgBox "Work is Done"
Exit Sub
End If
Next i 'Move to the next column across and loop
End Sub