Related
I am trying to write a code that it filters out by production day.
It then filters for the different lines (field 3) (Line A/B, Line C, etc)
and it then takes the item numbers for those and pastes it into another sheet.
However, now when I change the day criteria to another day - for example day 6...
not all the lines which existed in Day 1 exist.
So if I replace field 1, criteria one with 6 instead of 1, it messes up the sheet because Line A/B does not exist for Day 6.
how can i tweak this code so that even if that specific line filter does not exist for a certain day - it ignores or doesn't mess up the rest of the sheet.
Any help would be greatly appreciated!
Range("D7:O7").Select
Selection.AutoFilter
ActiveSheet.Range("$D$7:$O$52").AutoFilter Field:=10, Criteria1:=Array( _
"1,120.67", "1,200.00", "10,472.00", "121.00", "185.00", "190.50", "24.00", "241.50", _
"30.00", "436.00", "450.00", "465.00", "500.00", "525.00", "54.00", "60.00", "630.00", _
"71.00", "756.00", "893.00", "90.00", "984.50", "991.00"), Operator:= _
xlFilterValues
ActiveWindow.ScrollColumn = 1
ActiveSheet.Range("$D$7:$O$52").AutoFilter Field:=1, Criteria1:="1"
ActiveSheet.Range("$D$7:$O$52").AutoFilter Field:=3, Criteria1:="A/B"
Range("E8:E52").Select
Selection.Copy
Selection.SpecialCells(xlCellTypeVisible).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Production Schedule - Daily").Select
Range("I12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("July Production for Open Orders").Select
ActiveSheet.Range("$D$7:$O$52").AutoFilter Field:=3, Criteria1:="=B/C", _
Operator:=xlOr, Criteria2:="=Line B"
Range("E8:E52").Select
Application.CutCopyMode = False
Selection.Copy
Selection.SpecialCells(xlCellTypeVisible).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Production Schedule - Daily").Select
Range("U12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("July Production for Open Orders").Select
ActiveSheet.Range("$D$7:$O$52").AutoFilter Field:=3, Criteria1:="Line C"
Range("E8:E52").Select
Application.CutCopyMode = False
Selection.Copy
Selection.SpecialCells(xlCellTypeVisible).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Production Schedule - Daily").Select
Range("AG12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("July Production for Open Orders").Select
ActiveSheet.Range("$D$7:$O$52").AutoFilter Field:=3, Criteria1:="Line O"
Range("E8:E52").Select
Application.CutCopyMode = False
Selection.Copy
Selection.SpecialCells(xlCellTypeVisible).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Production Schedule - Daily").Select
Range("AS12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("July Production for Open Orders").Select
ActiveSheet.ShowAllData
Sheets("Production Schedule - Daily").Select
Range("E1").Select
You can improve your code by using some variables to refer to the sheets and ranges you're using, and by extracting the "copy and paste visible cells only" steps to a separate Sub which you can call from your main code. Use some error handling to take care of cases where all rows are filtered and there are no visible cells to copy.
Sub Tester()
Dim rngTable As Range, rngHdrs As Range, rngCopy As Range, ws As Worksheet
Dim rngVis As Range, wsPS As Worksheet
Set ws = ActiveSheet 'source sheet
Set wsPS = ws.Parent.Worksheets("Production Schedule - Daily")
Set rngTable = ws.Range("D7:O52") 'whole table
Set rngHdrs = rngTable.Rows(1) 'headers
Set rngCopy = rngTable.Columns(2).Offset(1, 0). _
Resize(rngTable.Rows.Count - 1) 'Col E, data only
rngHdrs.AutoFilter
rngTable.AutoFilter Field:=10, Criteria1:=Array( _
"1,120.67", "1,200.00", "10,472.00", "121.00", "185.00", "190.50", "24.00", "241.50", _
"30.00", "436.00", "450.00", "465.00", "500.00", "525.00", "54.00", "60.00", "630.00", _
"71.00", "756.00", "893.00", "90.00", "984.50", "991.00"), Operator:= _
xlFilterValues
rngTable.AutoFilter Field:=1, Criteria1:="1"
rngTable.AutoFilter Field:=3, Criteria1:="A/B"
CopyVisible rngCopy, wsPS.Range("I12")
rngTable.AutoFilter Field:=3, Criteria1:="=B/C", Operator:=xlOr, Criteria2:="=Line B"
CopyVisible rngCopy, wsPS.Range("U12")
rngTable.AutoFilter Field:=3, Criteria1:="Line C"
CopyVisible rngCopy, wsPS.Range("U12")
rngTable.AutoFilter Field:=3, Criteria1:="Line O"
CopyVisible rngCopy, wsPS.Range("AS12")
ws.ShowAllData
wsPS.Select
wsPS.Range("E1").Select
End Sub
'copy all visible cells from `rngFrom` and paste as values to `rngTo`
' Return False if no visible cells were found
Sub CopyVisible(rngFrom As Range, rngTo As Range)
Dim vis As Range
On Error Resume Next 'ignore error if no cells found
Set vis = rngFrom.SpecialCells(xlCellTypeVisible)
On Error GoTo 0 'stop ignoring errors
If Not vis Is Nothing Then
vis.Copy
rngTo.Cells(1).PasteSpecial Paste:=xlPasteValues
End If
End Sub
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 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'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